home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / muds / lpmud312.tar / lpmud312 / interpret.c < prev    next >
C/C++ Source or Header  |  1992-02-03  |  113KB  |  4,543 lines
  1. #include <varargs.h>
  2. #include <stdio.h>
  3. #include <setjmp.h>
  4. #include <string.h>
  5. #include <ctype.h>
  6. #include <sys/time.h>
  7. #include <sys/types.h>        /* sys/types.h and netinet/in.h are here to enable include of comm.h below */
  8. #include <sys/stat.h>
  9. /* #include <netinet/in.h> Included in comm.h below */
  10. #ifdef MARK
  11. #include <prof.h>
  12. #endif
  13. #include <memory.h>
  14.  
  15. #ifdef MARK
  16. #define CASE(x) case x: MARK(x);
  17. #else
  18. #define CASE(x) case x:
  19. #endif
  20.  
  21. #include "lint.h"
  22. #include "lang.h"
  23. #include "exec.h"
  24. #include "interpret.h"
  25. #include "config.h"
  26. #include "object.h"
  27. #include "wiz_list.h"
  28. #include "instrs.h"
  29. #include "patchlevel.h"
  30. #include "comm.h"
  31. #include "switch.h"
  32.  
  33. #ifdef RUSAGE            /* Defined in config.h */
  34. #include <sys/resource.h>
  35. extern int getrusage PROT((int, struct rusage *));
  36. #ifdef sun
  37. extern int getpagesize();
  38. #endif
  39. #ifndef RUSAGE_SELF
  40. #define RUSAGE_SELF    0
  41. #endif
  42. #endif
  43.  
  44. #if defined(__GNUC__) && !defined(lint)
  45. #define INLINE /* inline */ /* Another time ! */
  46. #else
  47. #define INLINE
  48. #endif
  49.  
  50. extern struct object *master_ob;
  51.  
  52. extern void print_svalue PROT((struct svalue *));
  53. static struct svalue *sapply PROT((char *, struct object *, int));
  54. static void do_trace PROT((char *, char *, char *));
  55. static int apply_low PROT((char *, struct object *, int));
  56. static int inter_sscanf PROT((int));
  57. static int strpref PROT((char *, char *));
  58. extern int do_rename PROT((char *, char *));     
  59.  
  60. extern struct object *previous_ob;
  61. extern char *last_verb;
  62. extern struct svalue const0, const1;
  63. struct program *current_prog;
  64. extern int current_time;
  65. extern struct object *current_heart_beat, *current_interactive;
  66.  
  67. static int tracedepth;
  68. #define TRACE_CALL 1
  69. #define TRACE_CALL_OTHER 2
  70. #define TRACE_RETURN 4
  71. #define TRACE_ARGS 8
  72. #define TRACE_EXEC 16
  73. #define TRACE_HEART_BEAT 32
  74. #define TRACE_APPLY 64
  75. #define TRACE_OBJNAME 128
  76. #define TRACETST(b) (command_giver->interactive->trace_level & (b))
  77. #define TRACEP(b) \
  78.     (command_giver && command_giver->interactive && TRACETST(b) && \
  79.      (command_giver->interactive->trace_prefix == 0 || \
  80.       (current_object && strpref(command_giver->interactive->trace_prefix, \
  81.           current_object->name))) )
  82. #define TRACEHB (current_heart_beat == 0 || (command_giver->interactive->trace_level & TRACE_HEART_BEAT))
  83.  
  84. /*
  85.  * Inheritance:
  86.  * An object X can inherit from another object Y. This is done with
  87.  * the statement 'inherit "file";'
  88.  * The inherit statement will clone a copy of that file, call reset
  89.  * in it, and set a pointer to Y from X.
  90.  * Y has to be removed from the linked list of all objects.
  91.  * All variables declared by Y will be copied to X, so that X has access
  92.  * to them.
  93.  *
  94.  * If Y isn't loaded when it is needed, X will be discarded, and Y will be
  95.  * loaded separetly. X will then be reloaded again.
  96.  */
  97. extern int d_flag;
  98.  
  99. extern int current_line, eval_cost;
  100.  
  101. /*
  102.  * These are the registers used at runtime.
  103.  * The control stack saves registers to be restored when a function
  104.  * will return. That means that control_stack[0] will have almost no
  105.  * interesting values, as it will terminate execution.
  106.  */
  107. static char *pc;        /* Program pointer. */
  108. static struct svalue *fp;    /* Pointer to first argument. */
  109. static struct svalue *sp;    /* Points to value of last push. */
  110. static short *break_sp;        /* Points to address to branch to
  111.                  * at next F_BREAK            */
  112. static int function_index_offset; /* Needed for inheritance */
  113. static int variable_index_offset; /* Needed for inheritance */
  114.  
  115. static struct svalue start_of_stack[EVALUATOR_STACK_SIZE];
  116. struct svalue catch_value;    /* Used to throw an error to a catch */
  117.  
  118. static struct control_stack control_stack[MAX_TRACE];
  119. static struct control_stack *csp;    /* Points to last element pushed */
  120.  
  121. /*
  122.  * May current_object shadow object 'ob' ? We rely heavily on the fact that
  123.  * function names are pointers to shared strings, which means that equality
  124.  * can be tested simply through pointer comparison.
  125.  */
  126. int validate_shadowing(ob)
  127.     struct object *ob;
  128. {
  129.     int i, j;
  130.     struct program *shadow = current_object->prog, *victim = ob->prog;
  131.     struct svalue *ret;
  132.  
  133.     if (current_object->shadowing)
  134.     error("shadow: Already shadowing.\n");
  135.     if (current_object->shadowed)
  136.     error("shadow: Can't shadow when shadowed.\n");
  137.     if (current_object->super)
  138.     error("The shadow must not reside inside another object.\n");
  139.     if (ob->shadowing)
  140.     error("Can't shadow a shadow.\n");
  141.     for (i=0; i < shadow->num_functions; i++) {
  142.     for (j=0; j < victim->num_functions; j++) {
  143.         if (shadow->functions[i].name != victim->functions[j].name)
  144.         continue;
  145.         if (victim->functions[j].type & TYPE_MOD_NO_MASK)
  146.         error("Illegal to shadow 'nomask' function \"%s\".\n",
  147.               victim->functions[j].name);
  148.     }
  149.     }
  150.     push_object(ob);
  151.     ret = apply_master_ob("query_allow_shadow", 1);
  152.     if (!(ob->flags & O_DESTRUCTED) &&
  153.     ret && !(ret->type == T_NUMBER && ret->u.number == 0))
  154.     {
  155.     return 1;
  156.     }
  157.     return 0;
  158. }
  159.  
  160. /*
  161.  * Information about assignments of values:
  162.  *
  163.  * There are three types of l-values: Local variables, global variables
  164.  * and vector elements.
  165.  *
  166.  * The local variables are allocated on the stack together with the arguments.
  167.  * the register 'frame_pointer' points to the first argument.
  168.  *
  169.  * The global variables must keep their values between executions, and
  170.  * have space allocated at the creation of the object.
  171.  *
  172.  * Elements in vectors are similar to global variables. There is a reference
  173.  * count to the whole vector, that states when to deallocate the vector.
  174.  * The elements consists of 'struct svalue's, and will thus have to be freed
  175.  * immediately when over written.
  176.  */
  177.  
  178. /*
  179.  * Push an object pointer on the stack. Note that the reference count is
  180.  * incremented.
  181.  * A destructed object must never be pushed onto the stack.
  182.  */
  183. INLINE
  184. void push_object(ob)
  185.     struct object *ob;
  186. {
  187.     sp++;
  188.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  189.     fatal("stack overflow\n");
  190.     sp->type = T_OBJECT;
  191.     sp->u.ob = ob;
  192.     add_ref(ob, "push_object");
  193. }
  194.  
  195. /*
  196.  * Push a number on the value stack.
  197.  */
  198. INLINE
  199. void push_number(n)
  200.     int n;
  201. {
  202.     sp++;
  203.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  204.     fatal("stack overflow\n");
  205.     sp->type = T_NUMBER;
  206.     sp->u.number = n;
  207. }
  208.  
  209. /*
  210.  * Push a string on the value stack.
  211.  */
  212. INLINE
  213. void push_string(p, type)
  214.     char *p;
  215.     int type;
  216. {
  217.     sp++;
  218.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  219.     fatal("stack overflow\n");
  220.     sp->type = T_STRING;
  221.     sp->string_type = type;
  222.     switch(type) {
  223.     case STRING_MALLOC:
  224.     sp->u.string = string_copy(p);
  225.     break;
  226.     case STRING_SHARED:
  227.     sp->u.string = make_shared_string(p);
  228.     break;
  229.     case STRING_CONSTANT:
  230.     sp->u.string = p;
  231.     break;
  232.     }
  233. }
  234.  
  235. /*
  236.  * Get address to a valid global variable.
  237.  */
  238. static INLINE struct svalue *find_value(num)
  239.     int num;
  240. {
  241. #ifdef DEBUG
  242.     if (num >= current_object->prog->num_variables) {
  243.     fatal("Illegal variable access %d(%d). See trace above.\n",
  244.         num, current_object->prog->num_variables);
  245.     }
  246. #endif
  247.     return ¤t_object->variables[num];
  248. }
  249.  
  250. /*
  251.  * Free the data that an svalue is pointing to. Not the svalue
  252.  * itself.
  253.  */
  254. void free_svalue(v)
  255.     struct svalue *v;
  256. {
  257.     switch(v->type) {
  258.     case T_STRING:
  259.     switch(v->string_type) {
  260.     case STRING_MALLOC:
  261.         free(v->u.string);
  262.         break;
  263.     case STRING_SHARED:
  264.         free_string(v->u.string);
  265.         break;
  266.     }
  267.     break;
  268.     case T_OBJECT:
  269.     free_object(v->u.ob, "free_svalue");
  270.     break;
  271.     case T_POINTER:
  272.     free_vector(v->u.vec);
  273.     break;
  274.     }
  275.     *v = const0; /* marion - clear this value all away */
  276. }
  277.  
  278. #ifndef COMPAT_MODE
  279. /*
  280.  * Prepend a slash in front of a string.
  281.  */
  282. static char *add_slash(str)
  283.     char *str;
  284. {
  285.     char *tmp;
  286.  
  287.     tmp = xalloc(strlen(str)+2);
  288.     strcpy(tmp,"/"); strcat(tmp,str);
  289.     return tmp;
  290. }
  291. #endif
  292.  
  293. /*
  294.  * Assign to a svalue.
  295.  * This is done either when element in vector, or when to an identifier
  296.  * (as all identifiers are kept in a vector pointed to by the object).
  297.  */
  298.  
  299. INLINE void assign_svalue_no_free(to, from)
  300.     struct svalue *to;
  301.     struct svalue *from;
  302. {
  303. #ifdef DEBUG
  304.     if (from == 0)
  305.     fatal("Null pointer to assign_svalue().\n");
  306. #endif
  307.     *to = *from;
  308.     switch(from->type) {
  309.     case T_STRING:
  310.     switch(from->string_type) {
  311.     case STRING_MALLOC:    /* No idea to make the string shared */
  312.         to->u.string = string_copy(from->u.string);
  313.         break;
  314.     case STRING_CONSTANT:    /* Good idea to make it shared */
  315.         to->string_type = STRING_SHARED;
  316.         /* FALL THROUGH ! */
  317.     case STRING_SHARED:    /* It already is shared */
  318.         to->u.string = make_shared_string(from->u.string);
  319.         break;
  320.     default:
  321.         fatal("Bad string type %d\n", from->string_type);
  322.     }
  323.     break;
  324.     case T_OBJECT:
  325.     add_ref(to->u.ob, "ass to var");
  326.     break;
  327.     case T_POINTER:
  328.     to->u.vec->ref++;
  329.     break;
  330.     }
  331. }
  332.  
  333. INLINE void assign_svalue(dest, v)
  334.     struct svalue *dest;
  335.     struct svalue *v;
  336. {
  337.     /* First deallocate the previous value. */
  338.     free_svalue(dest);
  339.     assign_svalue_no_free(dest, v);
  340. }
  341.  
  342. void push_svalue(v)
  343.     struct svalue *v;
  344. {
  345.     sp++;
  346.     assign_svalue_no_free(sp, v);
  347. }
  348.  
  349. /*
  350.  * Pop the top-most value of the stack.
  351.  * Don't do this if it is a value that will be used afterwards, as the
  352.  * data may be sent to free(), and destroyed.
  353.  */
  354. static INLINE void pop_stack() {
  355. #ifdef DEBUG
  356.     if (sp < start_of_stack)
  357.     fatal("Stack underflow.\n");
  358. #endif
  359.     free_svalue(sp);
  360.     sp--;
  361. }
  362.  
  363. /*
  364.  * Compute the address of an array element.
  365.  */
  366. static INLINE void push_indexed_lvalue()
  367. {
  368.     struct svalue *i, *vec, *item;
  369.     int ind;
  370.  
  371.     i = sp;
  372.     vec = sp - 1;
  373.     if (i->type != T_NUMBER || i->u.number < 0)
  374.     error("Illegal index\n");
  375.     ind = i->u.number;
  376.     pop_stack();
  377.     if (vec->type == T_STRING) {
  378.     static struct svalue one_character;
  379.     /* marion says: this is a crude part of code */
  380.     one_character.type = T_NUMBER;
  381.     if (ind > strlen(vec->u.string) || ind < 0)
  382.         one_character.u.number = 0;
  383.     else
  384.         one_character.u.number = vec->u.string[ind];
  385.     free_svalue(sp);
  386.     sp->type = T_LVALUE;
  387.     sp->u.lvalue = &one_character;
  388.     return;
  389.     }
  390.     if (vec->type != T_POINTER) error("Indexing on illegal type.\n");
  391.     if (ind >= vec->u.vec->size) error ("Index out of bounds\n");
  392.     item = &vec->u.vec->item[ind];
  393.     if (vec->u.vec->ref == 1) {
  394.     static struct svalue quickfix = { T_NUMBER };
  395.     /* marion says: but this is crude too */
  396.     /* marion blushes. */
  397.     assign_svalue (&quickfix, item);
  398.     item = &quickfix;
  399.     }
  400.     free_svalue(sp);        /* This will make 'vec' invalid to use */
  401.     sp->type = T_LVALUE;
  402.     sp->u.lvalue = item;
  403. }
  404.  
  405. #ifdef OPCPROF
  406. #define MAXOPC 512
  407. static int opcount[MAXOPC];
  408. #endif
  409.  
  410. /*
  411.  * Deallocate 'n' values from the stack.
  412.  */
  413. INLINE
  414. void pop_n_elems(n)
  415.     int n;
  416. {
  417. #ifdef DEBUG
  418.     if (n < 0)
  419.     fatal("pop_n_elems: %d elements.\n", n);
  420. #endif
  421.     for (; n>0; n--)
  422.     pop_stack();
  423. }
  424.  
  425. void bad_arg(arg, instr)
  426.     int arg, instr;
  427. {
  428.     error("Bad argument %d to %s()\n", arg, get_f_name(instr));
  429. }
  430.  
  431. INLINE
  432. static void push_control_stack(funp)
  433.     struct function *funp;
  434. {
  435.     if (csp == &control_stack[MAX_TRACE-1])
  436.     error("Too deep recursion.\n");
  437.     csp++;
  438.     csp->funp = funp;    /* Only used for tracebacks */
  439.     csp->ob = current_object;
  440.     csp->prev_ob = previous_ob;
  441.     csp->fp = fp;
  442.     csp->prog = current_prog;
  443.     /* csp->extern_call = 0; It is set by eval_instruction() */
  444.     csp->pc = pc;
  445.     csp->function_index_offset = function_index_offset;
  446.     csp->variable_index_offset = variable_index_offset;
  447.     csp->break_sp = break_sp;
  448. }
  449.  
  450. /*
  451.  * Pop the control stack one element, and restore registers.
  452.  * extern_call must not be modified here, as it is used imediately after pop.
  453.  */
  454. static void pop_control_stack() {
  455. #ifdef DEBUG
  456.     if (csp == control_stack - 1)
  457.     fatal("Popped out of the control stack");
  458. #endif
  459.     current_object = csp->ob;
  460.     current_prog = csp->prog;
  461.     previous_ob = csp->prev_ob;
  462.     pc = csp->pc;
  463.     fp = csp->fp;
  464.     function_index_offset = csp->function_index_offset;
  465.     variable_index_offset = csp->variable_index_offset;
  466.     break_sp = csp->break_sp;
  467.     csp--;
  468. }
  469.  
  470. /*
  471.  * Push a pointer to a vector on the stack. Note that the reference count
  472.  * is incremented. Newly created vectors normally have a reference count
  473.  * initialized to 1.
  474.  */
  475. INLINE void push_vector(v)
  476.     struct vector *v;
  477. {
  478.     v->ref++;
  479.     sp++;
  480.     sp->type = T_POINTER;
  481.     sp->u.vec = v;
  482. }
  483.  
  484. /*
  485.  * Push a string on the stack that is already malloced.
  486.  */
  487. static void INLINE push_malloced_string(p)
  488.     char *p;
  489. {
  490.     sp++;
  491.     sp->type = T_STRING;
  492.     sp->u.string = p;
  493.     sp->string_type = STRING_MALLOC;
  494. }
  495.  
  496. /*
  497.  * Push a string on the stack that is already constant.
  498.  */
  499. INLINE
  500. void push_constant_string(p)
  501.     char *p;
  502. {
  503.     sp++;
  504.     sp->type = T_STRING;
  505.     sp->u.string = p;
  506.     sp->string_type = STRING_CONSTANT;
  507. }
  508.  
  509. static void do_trace_call(funp)
  510.     struct function *funp;
  511. {
  512.     do_trace("Call direct ", funp->name, " ");
  513.     if (TRACEHB) {
  514.         if (TRACETST(TRACE_ARGS)) {
  515.             int i;
  516.             add_message(" with %d arguments: ", funp->num_arg);
  517.             for(i = funp->num_arg-1; i >= 0; i--) {
  518.                 print_svalue(&sp[-i]);
  519.                 add_message(" ");
  520.             }
  521.         }
  522.         add_message("\n");
  523.     }
  524. }
  525.  
  526. /*
  527.  * Argument is the function to execute. If it is defined by inheritance,
  528.  * then search for the real definition, and return it.
  529.  * There is a number of arguments on the stack. Normalize them and initialize
  530.  * local variables, so that the called function is pleased.
  531.  */
  532. static struct function *setup_new_frame(funp)
  533.     struct function *funp;
  534. {
  535.     function_index_offset = 0;
  536.     variable_index_offset = 0;
  537.     while(funp->flags & NAME_INHERITED) {
  538.     function_index_offset +=
  539.         current_prog->inherit[funp->offset].function_index_offset;
  540.     variable_index_offset +=
  541.         current_prog->inherit[funp->offset].variable_index_offset;
  542.     current_prog =
  543.         current_prog->inherit[funp->offset].prog;
  544.     funp = ¤t_prog->functions[funp->function_index_offset];
  545.     }
  546.     /* Remove excessive arguments */
  547.     while(csp->num_local_variables > funp->num_arg) {
  548.     pop_stack();
  549.     csp->num_local_variables--;
  550.     }
  551.     /* Correct number of arguments and local variables */
  552.     while(csp->num_local_variables < funp->num_arg + funp->num_local) {
  553.     push_number(0);
  554.     csp->num_local_variables++;
  555.     }
  556.     tracedepth++;
  557.     if (TRACEP(TRACE_CALL)) {
  558.     do_trace_call(funp);
  559.     }
  560.     fp = sp - csp->num_local_variables + 1;
  561.     break_sp = (short*)(sp+1);
  562.     return funp;
  563. }
  564.  
  565. static void break_point()
  566. {
  567.     if (sp - fp - csp->num_local_variables + 1 != 0)
  568.     fatal("Bad stack pointer.\n");
  569. }
  570.  
  571. /* marion
  572.  * maintain a small and inefficient stack of error recovery context
  573.  * data structures.
  574.  * This routine is called in three different ways:
  575.  * push=-1    Pop the stack.
  576.  * push=1    push the stack.
  577.  * push=0    No error occured, so the pushed value does not have to be
  578.  *        restored. The pushed value can simply be popped into the void.
  579.  *
  580.  * The stack is implemented as a linked list of stack-objects, allocated
  581.  * from the heap, and deallocated when popped.
  582.  */
  583. void push_pop_error_context (push)
  584.     int push;
  585. {
  586.     extern jmp_buf error_recovery_context;
  587.     extern int error_recovery_context_exists;
  588.     static struct error_context_stack {
  589.     jmp_buf old_error_context;
  590.     int old_exists_flag;
  591.     struct control_stack *save_csp;
  592.     struct object *save_command_giver;
  593.     struct svalue *save_sp;
  594.     struct error_context_stack *next;
  595.     } *ecsp = 0, *p;
  596.  
  597.     if (push == 1) {
  598.     /*
  599.      * Save some global variables that must be restored separately
  600.      * after a longjmp. The stack will have to be manually popped all
  601.      * the way.
  602.      */
  603.     p = (struct error_context_stack *)xalloc (sizeof *p);
  604.     p->save_sp = sp;
  605.     p->save_csp = csp;    
  606.     p->save_command_giver = command_giver;
  607.     memcpy (
  608.         (char *)p->old_error_context,
  609.         (char *)error_recovery_context,
  610.         sizeof error_recovery_context);
  611.     p->old_exists_flag = error_recovery_context_exists;
  612.     p->next = ecsp;
  613.     ecsp = p;
  614.     } else {
  615.     p = ecsp;
  616.     if (p == 0)
  617.         fatal("Catch: error context stack underflow");
  618.     if (push == 0) {
  619. #ifdef DEBUG
  620.         if (csp != p->save_csp-1)
  621.         fatal("Catch: Lost track of csp");
  622. #if 0
  623.         /*
  624.          * This test is not valid! The statement catch(exec("...")) will
  625.          * change the value of command_giver.
  626.          */
  627.         if (command_giver != p->save_command_giver)
  628.         fatal("Catch: Lost track of command_giver");
  629. #endif
  630. #endif
  631.     } else {
  632.         /* push == -1 !
  633.          * They did a throw() or error. That means that the control
  634.          * stack must be restored manually here.
  635.          */
  636.         csp = p->save_csp;    
  637.         pop_n_elems (sp - p->save_sp);
  638.         command_giver = p->save_command_giver;
  639.     }
  640.     memcpy ((char *)error_recovery_context,
  641.         (char *)p->old_error_context,
  642.         sizeof error_recovery_context);
  643.     error_recovery_context_exists = p->old_exists_flag;
  644.     ecsp = p->next;
  645.     free ((char *)p);
  646.     }
  647. }
  648.  
  649. /*
  650.  * When a vector is given as argument to an efun, all items has to be
  651.  * checked if there would be an destructed object.
  652.  * A bad problem currently is that a vector can contain another vector, so this
  653.  * should be tested too. But, there is currently no prevention against
  654.  * recursive vectors, which means that this can not be tested. Thus, the game
  655.  * may crash if a vector contains a vector that contains a destructed object
  656.  * and this top-most vector is used as an argument to an efun.
  657.  */
  658. /* The game won't crash when doing simple operations like assign_svalue
  659.  * on a destructed object. You have to watch out, of course, that you don't
  660.  * apply a function to it.
  661.  * to save space it is preferable that destructed objects are freed soon.
  662.  *   amylaar
  663.  */
  664. void check_for_destr(v)
  665.     struct vector *v;
  666. {
  667.     int i;
  668.  
  669.     for (i=0; i < v->size; i++) {
  670.     if (v->item[i].type != T_OBJECT)
  671.         continue;
  672.     if (!(v->item[i].u.ob->flags & O_DESTRUCTED))
  673.         continue;
  674.     assign_svalue(&v->item[i], &const0);
  675.     }
  676. }
  677.  
  678. /*
  679.  * Evaluate instructions at address 'p'. All program offsets are
  680.  * to current_prog->program. 'current_prog' must be setup before
  681.  * call of this function.
  682.  *
  683.  * There must not be destructed objects on the stack. The destruct_object()
  684.  * function will automatically remove all occurences. The effect is that
  685.  * all called efuns knows that they won't have destructed objects as
  686.  * arguments.
  687.  */
  688. #ifdef TRACE_CODE
  689. int previous_instruction[60];
  690. int stack_size[60];
  691. char *previous_pc[60];
  692. static int last;
  693. #endif
  694. static void eval_instruction(p)
  695.     char *p;
  696. {
  697.     struct object *ob;
  698.     int i, num_arg;
  699.     int instruction;
  700.     struct svalue *expected_stack, *argp;
  701.  
  702.     /* Next F_RETURN at this level will return out of eval_instruction() */
  703.     csp->extern_call = 1;
  704.     pc = p;
  705. again:
  706.     instruction = EXTRACT_UCHAR(pc);
  707. #ifdef TRACE_CODE
  708.     previous_instruction[last] = instruction + F_OFFSET;
  709.     previous_pc[last] = pc;
  710.     stack_size[last] = sp - fp - csp->num_local_variables;
  711.     last = (last + 1) % (sizeof previous_instruction / sizeof (int));
  712. #endif
  713.     pc++;
  714.     if (current_object->user)
  715.     current_object->user->cost++;
  716.     eval_cost++;
  717.     if (eval_cost > MAX_COST) {
  718.     printf("eval_cost too big %d\n", eval_cost);
  719.         eval_cost = 0;
  720.     error("Too long evaluation. Execution aborted.\n");
  721.     }
  722.     /*
  723.      * Execute current instruction. Note that all functions callable
  724.      * from LPC must return a value. This does not apply to control
  725.      * instructions, like F_JUMP.
  726.      */
  727.     if (instrs[instruction].min_arg != instrs[instruction].max_arg) {
  728.     num_arg = EXTRACT_UCHAR(pc);
  729.     pc++;
  730.     if (num_arg > 0) {
  731.         if (instrs[instruction].type[0] != 0 &&
  732.         (instrs[instruction].type[0] & (sp-num_arg+1)->type) == 0) {
  733.         bad_arg(1, instruction + F_OFFSET);
  734.         }
  735.     }
  736.     if (num_arg > 1) {
  737.         if (instrs[instruction].type[1] != 0 &&
  738.         (instrs[instruction].type[1] & (sp-num_arg+2)->type) == 0) {
  739.         bad_arg(2, instruction + F_OFFSET);
  740.         }
  741.     }
  742.     } else {
  743.     num_arg = instrs[instruction].min_arg;
  744.     if (instrs[instruction].min_arg > 0) {
  745.         if (instrs[instruction].type[0] != 0 &&
  746.         (instrs[instruction].type[0] & (sp-num_arg+1)->type) == 0) {
  747.         bad_arg(1, instruction + F_OFFSET);
  748.         }
  749.     }
  750.     if (instrs[instruction].min_arg > 1) {
  751.         if (instrs[instruction].type[1] != 0 &&
  752.         (instrs[instruction].type[1] & (sp-num_arg+2)->type) == 0) {
  753.         bad_arg(2, instruction + F_OFFSET);
  754.         }
  755.     }
  756.     /*
  757.      * Safety measure. It is supposed that the evaluator knows
  758.      * the number of arguments.
  759.      */
  760.     num_arg = -1;
  761.     }
  762.     if (num_arg != -1) {
  763.     expected_stack = sp - num_arg + 1;
  764. #ifdef DEBUG
  765.     } else {
  766.     expected_stack = 0;
  767. #endif
  768.     }
  769.     instruction += F_OFFSET;
  770. #ifdef OPCPROF
  771.     if (instruction >= 0 && instruction < MAXOPC) opcount[instruction]++;
  772. #endif
  773.     /*
  774.      * Execute the instructions. The number of arguments are correct,
  775.      * and the type of the two first arguments are also correct.
  776.      */
  777.     if (TRACEP(TRACE_EXEC)) {
  778.     do_trace("Exec ", get_f_name(instruction), "\n");
  779.     }
  780.     switch(instruction) {
  781.     default:
  782.     fatal("Undefined instruction %s (%d)\n", get_f_name(instruction),
  783.           instruction);
  784.     /*NOTREACHED*/
  785.     CASE(F_REGEXP);
  786.     {
  787.     struct vector *v;
  788.     v = match_regexp((sp-1)->u.vec, sp->u.string);
  789.     pop_n_elems(2);
  790.     if (v == 0)
  791.         push_number(0);
  792.     else {
  793.         push_vector(v);
  794.         v->ref--;        /* Will make ref count == 1 */
  795.     }
  796.     break;
  797.     }
  798.     CASE(F_SHADOW);
  799.     ob = (sp-1)->u.ob;
  800.     if (sp->u.number == 0) {
  801.         ob = ob->shadowed;
  802.         pop_n_elems(2);
  803.         if (ob)
  804.         push_object(ob);
  805.         else
  806.         push_number(0);
  807.         break;
  808.     }
  809.     if (validate_shadowing(ob)) {
  810.         /*
  811.          * The shadow is entered first in the chain.
  812.          */
  813.         while (ob->shadowed)
  814.         ob = ob->shadowed;
  815.         current_object->shadowing = ob;
  816.         ob->shadowed = current_object;
  817.         pop_n_elems(2);
  818.         push_object(ob);
  819.         break;
  820.     }
  821.     pop_n_elems(2);
  822.     push_number(0);
  823.     break;
  824.     CASE(F_POP_VALUE);
  825.     pop_stack();
  826.     break;
  827.     CASE(F_DUP);
  828.     sp++;
  829.     assign_svalue_no_free(sp, sp-1);
  830.     break;
  831.     CASE(F_JUMP_WHEN_ZERO);
  832.     {
  833.     unsigned short offset;
  834.  
  835.     ((char *)&offset)[0] = pc[0];
  836.     ((char *)&offset)[1] = pc[1];
  837.     if (sp->type == T_NUMBER && sp->u.number == 0)
  838.         pc = current_prog->program + offset;
  839.     else
  840.         pc += 2;
  841.     pop_stack();
  842.     break;
  843.     }
  844.     CASE(F_JUMP);
  845.     {
  846.     unsigned short offset;
  847.  
  848.     ((char *)&offset)[0] = pc[0];
  849.     ((char *)&offset)[1] = pc[1];
  850.     pc = current_prog->program + offset;
  851.     break;
  852.     }
  853.     CASE(F_JUMP_WHEN_NON_ZERO);
  854.     {
  855.     unsigned short offset;
  856.  
  857.     ((char *)&offset)[0] = pc[0];
  858.     ((char *)&offset)[1] = pc[1];
  859.     if (sp->type == T_NUMBER && sp->u.number == 0)
  860.         pc += 2;
  861.     else
  862.         pc = current_prog->program + offset;
  863.     pop_stack();
  864.     break;
  865.     }
  866.     CASE(F_INDIRECT);
  867. #ifdef DEBUG
  868.     if (sp->type != T_LVALUE)
  869.         fatal("Bad type to F_INDIRECT\n");
  870. #endif
  871.     assign_svalue(sp, sp->u.lvalue);
  872.     /*
  873.      * Fetch value of a variable. It is possible that it is a variable
  874.      * that points to a destructed object. In that case, it has to
  875.      * be replaced by 0.
  876.      */
  877.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  878.         free_svalue(sp);
  879.         *sp = const0;
  880.     }
  881.     break;
  882.     CASE(F_IDENTIFIER);
  883.     sp++;
  884.     assign_svalue_no_free(sp, find_value((int)(EXTRACT_UCHAR(pc) +
  885.                            variable_index_offset)));
  886.     pc++;
  887.     /*
  888.      * Fetch value of a variable. It is possible that it is a variable
  889.      * that points to a destructed object. In that case, it has to
  890.      * be replaced by 0.
  891.      */
  892.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  893.         free_svalue(sp);
  894.         *sp = const0;
  895.     }
  896.     break;
  897.     CASE(F_PUSH_IDENTIFIER_LVALUE);
  898.     sp++;
  899.     sp->type = T_LVALUE;
  900.     sp->u.lvalue = find_value((int)(EXTRACT_UCHAR(pc) +
  901.                     variable_index_offset));
  902.     pc++;
  903.     break;
  904.     CASE(F_PUSH_INDEXED_LVALUE);
  905.     push_indexed_lvalue();
  906.     break;
  907.     CASE(F_INDEX);
  908.     push_indexed_lvalue();
  909.     assign_svalue_no_free(sp, sp->u.lvalue);
  910.     /*
  911.      * Fetch value of a variable. It is possible that it is a variable
  912.      * that points to a destructed object. In that case, it has to
  913.      * be replaced by 0.
  914.      */
  915.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  916.         free_svalue(sp);
  917.         sp->type = T_NUMBER;
  918.         sp->u.number = 0;
  919.     }
  920.     break;
  921.     CASE(F_LOCAL_NAME);
  922.     sp++;
  923.     assign_svalue_no_free(sp, fp + EXTRACT_UCHAR(pc));
  924.     pc++;
  925.     /*
  926.      * Fetch value of a variable. It is possible that it is a variable
  927.      * that points to a destructed object. In that case, it has to
  928.      * be replaced by 0.
  929.      */
  930.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  931.         free_svalue(sp);
  932.         *sp = const0;
  933.     }
  934.     break;
  935.     CASE(F_PUSH_LOCAL_VARIABLE_LVALUE);
  936.     sp++;
  937.     sp->type = T_LVALUE;
  938.     sp->u.lvalue = fp + EXTRACT_UCHAR(pc);
  939.     pc++;
  940.     break;
  941.     CASE(F_RETURN);
  942.     {
  943.     struct svalue sv;
  944.  
  945.     sv = *sp--;
  946.     /*
  947.      * Deallocate frame and return.
  948.      */
  949.     for (i=0; i < csp->num_local_variables; i++)
  950.         pop_stack();
  951.     sp++;
  952. #ifdef DEBUG
  953.     if (sp != fp)
  954.         fatal("Bad stack at F_RETURN\n"); /* marion */
  955. #endif
  956.     *sp = sv;    /* This way, the same ref counts are maintained */
  957.     pop_control_stack();
  958.     tracedepth--;
  959.     if (TRACEP(TRACE_RETURN)) {
  960.         do_trace("Return", "", "");
  961.         if (TRACEHB) {
  962.         if (TRACETST(TRACE_ARGS)) {
  963.             add_message(" with value: ");
  964.             print_svalue(sp);
  965.         }
  966.         add_message("\n");
  967.         }
  968.     }
  969.     if (csp[1].extern_call)    /* The control stack was popped just before */
  970.         return;
  971.     break;
  972.     }
  973.     CASE(F_BREAK_POINT);
  974.     break_point();    /* generated by lang.y when -d. Will check stack. */
  975.     break;
  976.     CASE(F_CLONE_OBJECT);
  977.     ob = clone_object(sp->u.string);
  978.     pop_stack();
  979.     if (ob) {
  980.         sp++;
  981.         sp->type = T_OBJECT;
  982.         sp->u.ob = ob;
  983.         add_ref(ob, "F_CLONE_OBJECT");
  984.     } else {
  985.         push_number(0);
  986.     }
  987.     break;
  988.     CASE(F_AGGREGATE);
  989.     {
  990.     struct vector *v;
  991.     unsigned short num;
  992.  
  993.     ((char *)&num)[0] = pc[0];
  994.     ((char *)&num)[1] = pc[1];
  995.     pc += 2;
  996.     v = allocate_array((int)num);
  997.     for (i=0; i < num; i++)
  998.         assign_svalue_no_free(&v->item[i], sp + i - num + 1);
  999.     pop_n_elems((int)num);
  1000.     sp++;
  1001.     sp->type = T_POINTER;
  1002.     sp->u.vec = v;        /* Ref count already initialized */
  1003.     break;
  1004.     }
  1005.     CASE(F_TAIL);
  1006.     if (tail(sp->u.string))
  1007.         assign_svalue(sp, &const1);
  1008.     else
  1009.         assign_svalue(sp, &const0);
  1010.     break;
  1011.     CASE(F_CALL_FUNCTION_BY_ADDRESS);
  1012.     {
  1013.     unsigned short func_index;
  1014.     struct function *funp;
  1015.  
  1016.     ((char *)&func_index)[0] = pc[0];
  1017.     ((char *)&func_index)[1] = pc[1];
  1018.     pc += 2;
  1019.     func_index += function_index_offset;
  1020.     /*
  1021.      * Find the function in the function table. As the function may have
  1022.      * been redefined by inheritance, we must look in the last table,
  1023.      * which is pointed to by current_object.
  1024.      */
  1025. #ifdef DEBUG
  1026.     if (func_index >= current_object->prog->num_functions)
  1027.         fatal("Illegal function index\n");
  1028. #endif
  1029.  
  1030.     /* NOT current_prog, which can be an inherited object. */
  1031.     funp = ¤t_object->prog->functions[func_index];
  1032.  
  1033.     if (funp->flags & NAME_UNDEFINED)
  1034.         error("Undefined function: %s\n", funp->name);
  1035.     /* Save all important global stack machine registers */
  1036.     push_control_stack(funp);    /* return pc is adjusted later */
  1037.  
  1038.     /* This assigment must be done after push_control_stack() */
  1039.     current_prog = current_object->prog;
  1040.     /*
  1041.      * If it is an inherited function, search for the real
  1042.      * definition.
  1043.      */
  1044.     csp->num_local_variables = EXTRACT_UCHAR(pc);
  1045.     pc++;
  1046.     funp = setup_new_frame(funp);
  1047.     csp->pc = pc;    /* The corrected return address */
  1048.     pc = current_prog->program + funp->offset;
  1049.     csp->extern_call = 0;
  1050.     break;
  1051.     }
  1052.     CASE(F_SAVE_OBJECT);
  1053.     save_object(current_object, sp->u.string);
  1054.     /* The argument is returned */
  1055.     break;
  1056.     CASE(F_FIND_OBJECT);
  1057.     ob = find_object2(sp->u.string);
  1058.     pop_stack();
  1059.     if (ob)
  1060.         push_object(ob);
  1061.     else
  1062.         push_number(0);
  1063.     break;
  1064.     CASE(F_FIND_PLAYER);
  1065.     ob = find_living_object(sp->u.string, 1);
  1066.     pop_stack();
  1067.     if (!ob)
  1068.         push_number(0);
  1069.     else
  1070.         push_object(ob);
  1071.     break;
  1072.     CASE(F_WRITE_FILE);
  1073.     i = write_file((sp-1)->u.string, sp->u.string);
  1074.     pop_n_elems(2);
  1075.     push_number(i);
  1076.     break;
  1077.     CASE(F_READ_FILE);
  1078.     {
  1079.     char *str;
  1080.     struct svalue *arg = sp- num_arg + 1;
  1081.     int start = 0, len = 0;
  1082.  
  1083.     if (num_arg > 1)
  1084.         start = arg[1].u.number;
  1085.     if (num_arg == 3) {
  1086.         if (arg[2].type != T_NUMBER)
  1087.         bad_arg(2, instruction);
  1088.         len = arg[2].u.number;
  1089.     }
  1090.  
  1091.     str = read_file(arg[0].u.string, start, len);
  1092.     pop_n_elems(num_arg);
  1093.     if (str == 0)
  1094.         push_number(0);
  1095.     else {
  1096.         push_string(str, STRING_MALLOC);
  1097.         free(str);
  1098.     }
  1099.     break;
  1100.     }
  1101.     CASE(F_READ_BYTES);
  1102.     {
  1103.     char *str;
  1104.     struct svalue *arg = sp- num_arg + 1;
  1105.     int start = 0, len = 0;
  1106.  
  1107.     if (num_arg > 1)
  1108.         start = arg[1].u.number;
  1109.     if (num_arg == 3) {
  1110.         if (arg[2].type != T_NUMBER)
  1111.         bad_arg(2, instruction);
  1112.         len = arg[2].u.number;
  1113.     }
  1114.  
  1115.     str = read_bytes(arg[0].u.string, start, len);
  1116.     pop_n_elems(num_arg);
  1117.     if (str == 0)
  1118.         push_number(0);
  1119.     else {
  1120.         push_string(str, STRING_MALLOC);
  1121.         free(str);
  1122.     }
  1123.     break;
  1124.     }
  1125.     CASE(F_WRITE_BYTES);
  1126.     i = write_bytes((sp-2)->u.string, (sp-1)->u.number, sp->u.string);
  1127.     pop_n_elems(3);
  1128.     push_number(i);
  1129.     break;
  1130.     CASE(F_FILE_SIZE);
  1131.     i = file_size(sp->u.string);
  1132.     pop_stack();
  1133.     push_number(i);
  1134.     break;
  1135.     CASE(F_FIND_LIVING);
  1136.     ob = find_living_object(sp->u.string, 0);
  1137.     pop_stack();
  1138.     if (!ob)
  1139.         push_number(0);
  1140.     else
  1141.         push_object(ob);
  1142.     break;
  1143.     CASE(F_TELL_OBJECT);
  1144.     tell_object((sp-1)->u.ob, sp->u.string);
  1145.     pop_stack();    /* Return first argument */
  1146.     break;
  1147.     CASE(F_RESTORE_OBJECT);
  1148.     i = restore_object(current_object, sp->u.string);
  1149.     pop_stack();
  1150.     push_number(i);
  1151.     break;
  1152.     CASE(F_THIS_PLAYER);
  1153.     pop_n_elems(num_arg);
  1154.     if (num_arg && current_interactive &&
  1155.         !(current_interactive->flags & O_DESTRUCTED))
  1156.         push_object(current_interactive);
  1157.     else if (command_giver && !(command_giver->flags & O_DESTRUCTED))
  1158.         push_object(command_giver);
  1159.     else
  1160.         push_number(0);
  1161.     break;
  1162. #ifdef F_FIRST_INVENTORY
  1163.     CASE(F_FIRST_INVENTORY);
  1164.     ob = first_inventory(sp);
  1165.     pop_stack();
  1166.     if (ob)
  1167.         push_object(ob);
  1168.     else
  1169.         push_number(0);
  1170.     break;
  1171. #endif /* F_FIRST_INVENTORY */
  1172.     CASE(F_LIVING);
  1173.     if (sp->u.ob->flags & O_ENABLE_COMMANDS)
  1174.         assign_svalue(sp, &const1);
  1175.     else
  1176.         assign_svalue(sp, &const0);
  1177.     break;
  1178. #ifdef F_GETUID
  1179.     CASE(F_GETUID);
  1180.     /*
  1181.      * Are there any reasons to support this one in -o mode ?
  1182.      */
  1183.     ob = sp->u.ob;
  1184. #ifdef DEBUG
  1185.     if (ob->user == 0)
  1186.         fatal("User is null pointer\n");
  1187. #endif
  1188.     {   char *tmp;
  1189.         tmp = ob->user->name;
  1190.         pop_stack();
  1191.         push_string(tmp, STRING_CONSTANT);
  1192.     }
  1193.     break;
  1194. #endif /* F_GETUID */
  1195. #ifdef F_GETEUID
  1196.     CASE(F_GETEUID);
  1197.     /*
  1198.      * Are there any reasons to support this one in -o mode ?
  1199.      */
  1200.     ob = sp->u.ob;
  1201.  
  1202.     if (ob->eff_user) {
  1203.         char *tmp;
  1204.         tmp = ob->eff_user->name;
  1205.         pop_stack();
  1206.         push_string(tmp, STRING_CONSTANT);
  1207.     }
  1208.     else {
  1209.         pop_stack();
  1210.         push_number(0);
  1211.     }
  1212.     break;
  1213. #endif /* F_GETEUID */
  1214. #ifdef F_EXPORT_UID
  1215.     CASE(F_EXPORT_UID);
  1216.     if (current_object->eff_user == 0)
  1217.         error("Illegal to export uid 0\n");
  1218.     ob = sp->u.ob;
  1219.     if (ob->eff_user)    /* Only allowed to export when null */
  1220.         break;
  1221.     ob->user = current_object->eff_user;
  1222.     break;
  1223. #endif /* F_EXPORT_UID */
  1224. #ifdef F_SETEUID
  1225.     CASE(F_SETEUID);
  1226.     {
  1227.     struct svalue *ret;
  1228.  
  1229.     if (sp->type == T_NUMBER) {
  1230.         if (sp->u.number != 0)
  1231.         bad_arg(1, F_SETEUID);
  1232.         current_object->eff_user = 0;
  1233.         pop_stack();
  1234.         push_number(1);
  1235.         break;
  1236.     }
  1237.     argp = sp;
  1238.     if (argp->type != T_STRING)
  1239.         bad_arg(1, F_SETEUID);
  1240.     push_object(current_object);
  1241.     push_string(argp->u.string, STRING_CONSTANT);
  1242.     ret = apply_master_ob("valid_seteuid", 2);
  1243.     if (ret == 0 || ret->type != T_NUMBER || ret->u.number != 1) {
  1244.         pop_stack();
  1245.         push_number(0);
  1246.         break;
  1247.     }
  1248.     current_object->eff_user = add_name(argp->u.string);
  1249.     pop_stack();
  1250.     push_number(1);
  1251.     break;
  1252.     }
  1253. #endif /* F_SETEUID */
  1254. #ifdef F_SETUID
  1255.     CASE(F_SETUID)
  1256.     setuid();
  1257.     push_number(0);
  1258.     break;
  1259. #endif /* F_SETUID */
  1260. #ifdef F_CREATOR
  1261.     CASE(F_CREATOR);
  1262.     ob = sp->u.ob;
  1263.     if (ob->user == 0) {
  1264.         assign_svalue(sp, &const0);
  1265.     } else {
  1266.         pop_stack();
  1267.         push_string(ob->user->name, STRING_CONSTANT);
  1268.     }
  1269.     break;
  1270. #endif
  1271.     CASE(F_SHUTDOWN);
  1272.     startshutdowngame();
  1273.     push_number(0);
  1274.     break;
  1275.     CASE(F_EXPLODE);
  1276.     {
  1277.     struct vector *v;
  1278.     v = explode_string((sp-1)->u.string, sp->u.string);
  1279.     pop_n_elems(2);
  1280.     if (v) {
  1281.         push_vector(v);    /* This will make ref count == 2 */
  1282.         v->ref--;
  1283.     } else {
  1284.         push_number(0);
  1285.     }
  1286.     break;
  1287.     }
  1288.     CASE(F_FILTER_ARRAY);
  1289.     {
  1290.     struct vector *v;
  1291.     struct svalue *arg;
  1292.  
  1293.     arg = sp - num_arg + 1; ob = 0;
  1294.  
  1295.     if (arg[2].type == T_OBJECT)
  1296.         ob = arg[2].u.ob;
  1297.     else if (arg[2].type == T_STRING) 
  1298.         ob = find_object(arg[2].u.string);
  1299.  
  1300.     if (!ob)
  1301.         error("Bad third argument to filter_array()\n");
  1302.  
  1303.     if (arg[0].type == T_POINTER) {
  1304.         check_for_destr(arg[0].u.vec);
  1305.         v = filter(arg[0].u.vec, arg[1].u.string, ob,
  1306.                num_arg > 3 ? sp : (struct svalue *)0); 
  1307.     } else {
  1308.         v = 0;
  1309.     }
  1310.     
  1311.     pop_n_elems(num_arg);
  1312.     if (v) {
  1313.         push_vector(v); /* This will make ref count == 2 */
  1314.         v->ref--;
  1315.     } else {
  1316.         push_number(0);
  1317.     }
  1318.     break;
  1319.     }
  1320.     CASE(F_SET_BIT);
  1321.     {
  1322.     char *str;
  1323.     int len, old_len, ind;
  1324.  
  1325.     if (sp->u.number > MAX_BITS)
  1326.         error("set_bit: too big bit number: %d\n", sp->u.number);
  1327.     len = strlen((sp-1)->u.string);
  1328.     old_len = len;
  1329.     ind = sp->u.number/6;
  1330.     if (ind >= len)
  1331.         len = ind + 1;
  1332.     str = xalloc(len+1);
  1333.     str[len] = '\0';
  1334.     if (old_len)
  1335.         memcpy(str, (sp-1)->u.string, old_len);
  1336.     if (len > old_len)
  1337.         memset(str + old_len, ' ', len - old_len);
  1338.     if (str[ind] > 0x3f + ' ' || str[ind] < ' ')
  1339.         error("Illegal bit pattern in set_bit character %d\n", ind);
  1340.     str[ind] = (str[ind] - ' ' | 1 << sp->u.number % 6) + ' ';
  1341.     pop_n_elems(2);
  1342.     sp++;
  1343.     sp->u.string = str;
  1344.     sp->string_type = STRING_MALLOC;
  1345.     sp->type = T_STRING;
  1346.     break;
  1347.     }
  1348.     CASE(F_CLEAR_BIT);
  1349.     {
  1350.     char *str;
  1351.     int len, ind;
  1352.  
  1353.     if (sp->u.number > MAX_BITS)
  1354.         error("clear_bit: too big bit number: %d\n", sp->u.number);
  1355.     len = strlen((sp-1)->u.string);
  1356.     ind = sp->u.number/6;
  1357.     if (ind >= len) {
  1358.         /* Return first argument unmodified ! */
  1359.         pop_stack();
  1360.         break;
  1361.     }
  1362.     str = xalloc(len+1);
  1363.     memcpy(str, (sp-1)->u.string, len+1);    /* Including null byte */
  1364.     if (str[ind] > 0x3f + ' ' || str[ind] < ' ')
  1365.         error("Illegal bit pattern in clear_bit character %d\n", ind);
  1366.     str[ind] = (str[ind] - ' ' & ~(1 << sp->u.number % 6)) + ' ';
  1367.     pop_n_elems(2);
  1368.     sp++;
  1369.     sp->type = T_STRING;
  1370.     sp->string_type = STRING_MALLOC;
  1371.     sp->u.string = str;
  1372.     break;
  1373.     }
  1374.     CASE(F_TEST_BIT);
  1375.     {
  1376.     int len;
  1377.  
  1378.     len = strlen((sp-1)->u.string);
  1379.     if (sp->u.number/6 >= len) {
  1380.         pop_n_elems(2);
  1381.         push_number(0);
  1382.         break;
  1383.     }
  1384.     if ((sp-1)->u.string[sp->u.number/6] - ' ' & 1 << sp->u.number % 6) {
  1385.         pop_n_elems(2);
  1386.         push_number(1);
  1387.     } else {
  1388.         pop_n_elems(2);
  1389.         push_number(0);
  1390.     }
  1391.     break;
  1392.     }
  1393.     CASE(F_QUERY_LOAD_AVERAGE);
  1394.     push_string(query_load_av(), STRING_MALLOC);
  1395.     break;
  1396.     CASE(F_CATCH);
  1397.     /*
  1398.      * Catch/Throw - catch errors in system or other peoples routines.
  1399.      */
  1400.     {
  1401.     extern jmp_buf error_recovery_context;
  1402.     extern int error_recovery_context_exists;
  1403.     extern struct svalue catch_value;
  1404.     unsigned short new_pc_offset;
  1405.  
  1406.     /*
  1407.      * Compute address of next instruction after the CATCH statement.
  1408.      */
  1409.     ((char *)&new_pc_offset)[0] = pc[0];
  1410.     ((char *)&new_pc_offset)[1] = pc[1];
  1411.     pc += 2;
  1412.  
  1413.     push_control_stack(0);
  1414.     csp->num_local_variables = 0;    /* No extra variables */
  1415.     csp->pc = current_prog->program + new_pc_offset;
  1416.     csp->num_local_variables = (csp-1)->num_local_variables; /* marion */
  1417.     /*
  1418.      * Save some global variables that must be restored separately
  1419.      * after a longjmp. The stack will have to be manually popped all
  1420.      * the way.
  1421.      */
  1422.     push_pop_error_context (1);
  1423.     
  1424.     /* signal catch OK - print no err msg */
  1425.        error_recovery_context_exists = 2;
  1426.     if (setjmp(error_recovery_context)) {
  1427.         /*
  1428.          * They did a throw() or error. That means that the control
  1429.          * stack must be restored manually here.
  1430.          * Restore the value of expected_stack also. It is always 0
  1431.          * for catch().
  1432.          */
  1433.         expected_stack = 0;
  1434.         push_pop_error_context (-1);
  1435.         pop_control_stack();
  1436.         assign_svalue_no_free(++sp, &catch_value);
  1437.     }
  1438.  
  1439.     /* next error will return 1 by default */
  1440.     assign_svalue(&catch_value, &const1);
  1441.     break;
  1442.     }
  1443.     CASE(F_THROW);
  1444.     /* marion
  1445.      * the return from catch is now done by a 0 throw
  1446.      */
  1447.     assign_svalue(&catch_value, sp--);
  1448.     if (catch_value.type == T_NUMBER && catch_value.u.number == 0) {
  1449.         /* We come here when no longjmp() was executed. */
  1450.         pop_control_stack();
  1451.         push_pop_error_context (0);
  1452.         push_number(0);
  1453.     } else throw_error(); /* do the longjump, with extra checks... */
  1454.     break;
  1455.     CASE(F_NOTIFY_FAIL);
  1456.     set_notify_fail_message(sp->u.string);
  1457.     /* Return the argument */
  1458.     break;
  1459.     CASE(F_QUERY_IDLE);
  1460.     i = query_idle(sp->u.ob);
  1461.     pop_stack();
  1462.     push_number(i);
  1463.     break;
  1464.     CASE(F_INTERACTIVE);
  1465.         i = (int)sp->u.ob->interactive;
  1466.     pop_stack();
  1467.     push_number(i);
  1468.     break;
  1469.     CASE(F_IMPLODE);
  1470.     {
  1471.     char *str;
  1472.     check_for_destr((sp-1)->u.vec);
  1473.     str = implode_string((sp-1)->u.vec, sp->u.string);
  1474.     pop_n_elems(2);
  1475.     if (str) {
  1476.         sp++;
  1477.         sp->type = T_STRING;
  1478.         sp->string_type = STRING_MALLOC;
  1479.         sp->u.string = str;
  1480.     } else {
  1481.         push_number(0);
  1482.     }
  1483.     break;
  1484.     }
  1485.     CASE(F_QUERY_SNOOP);
  1486.     {
  1487. #ifdef COMPAT_MODE
  1488.     struct svalue *arg1;
  1489. #endif
  1490.  
  1491.     if (command_giver == 0 || sp->u.ob->interactive == 0 || (command_giver->flags & O_DESTRUCTED)) {
  1492.         assign_svalue(sp, &const0);
  1493.         break;
  1494.     }
  1495. #ifdef COMPAT_MODE
  1496.     arg1 = sapply("query_level", command_giver, 0);
  1497.     if (arg1 == 0 || arg1->type != T_NUMBER || arg1->u.number < 22) {
  1498.         assign_svalue(sp, &const0);
  1499.         break;
  1500.     }
  1501.     ob = query_snoop(sp->u.ob);
  1502. #else
  1503.     assert_master_ob_loaded();
  1504.     if (current_object == master_ob)
  1505.         ob = query_snoop(sp->u.ob);
  1506.     else
  1507.         ob = 0;
  1508. #endif
  1509.     pop_stack();
  1510.     if (ob)
  1511.         push_object(ob);
  1512.     else
  1513.         push_number(0);
  1514.     break;
  1515.     }
  1516.     CASE(F_QUERY_IP_NUMBER);
  1517.     CASE(F_QUERY_IP_NAME);
  1518.     {
  1519.     extern char *query_ip_number PROT((struct object *));
  1520.      extern char *query_ip_name PROT((struct object *));
  1521.     char *tmp;
  1522.  
  1523.     if (num_arg == 1 && sp->type != T_OBJECT)
  1524.         error("Bad optional argument to query_ip_number()\n");
  1525.     if (instruction == F_QUERY_IP_NAME)
  1526.         tmp = query_ip_name(num_arg ? sp->u.ob : 0);
  1527.     else
  1528.         tmp = query_ip_number(num_arg ? sp->u.ob : 0);
  1529.     if (num_arg)
  1530.         pop_stack();
  1531.     if (tmp == 0)
  1532.         push_number(0);
  1533.     else
  1534.         push_string(tmp, STRING_MALLOC);
  1535.     break;
  1536.     }
  1537.     CASE(F_QUERY_HOST_NAME);
  1538.     {
  1539.     extern char *query_host_name();
  1540.     char *tmp;
  1541.  
  1542.     tmp = query_host_name();
  1543.     if (tmp)
  1544.         push_string(tmp, STRING_CONSTANT);
  1545.     else
  1546.         push_number(0);
  1547.     break;
  1548.     }
  1549. #ifdef F_NEXT_INVENTORY
  1550.     CASE(F_NEXT_INVENTORY);
  1551.     ob = sp->u.ob;
  1552.     pop_stack();
  1553.     if (ob->next_inv)
  1554.         push_object(ob->next_inv);
  1555.     else
  1556.         push_number(0);
  1557.     break;
  1558. #endif /* F_NEXT_INVENTORY */
  1559.     CASE(F_ALL_INVENTORY);
  1560.     {
  1561.     struct vector *vec;
  1562.     vec = all_inventory(sp->u.ob);
  1563.     pop_stack();
  1564.     if (vec == 0) {
  1565.         push_number(0);
  1566.     } else {
  1567.         push_vector(vec); /* This will make ref count == 2 */
  1568.         vec->ref--;
  1569.     }
  1570.     break;
  1571.     }
  1572.     CASE(F_DEEP_INVENTORY);
  1573.     {
  1574.     struct vector *vec;
  1575.  
  1576.     vec = deep_inventory(sp->u.ob, 0);
  1577.     free_svalue(sp);
  1578.     sp->type = T_POINTER;
  1579.     sp->u.vec = vec;
  1580.     break;
  1581.     }
  1582.     CASE(F_ENVIRONMENT);
  1583.     if (num_arg) {
  1584.         ob = environment(sp);
  1585.         pop_stack();
  1586.     } else if (!(current_object->flags & O_DESTRUCTED)) {
  1587.         ob = current_object->super;
  1588.     } else
  1589.         ob = 0;
  1590.     if (ob)
  1591.         push_object(ob);
  1592.     else
  1593.         push_number(0);
  1594.     break;
  1595.     CASE(F_THIS_OBJECT);
  1596.     if (current_object->flags & O_DESTRUCTED)
  1597.         push_number(0);
  1598.     else
  1599.         push_object(current_object);
  1600.     break;
  1601.     CASE(F_PREVIOUS_OBJECT);
  1602.     if (previous_ob == 0 || (previous_ob->flags & O_DESTRUCTED))
  1603.         push_number(0);
  1604.     else
  1605.         push_object(previous_ob);
  1606.     break;
  1607. #ifdef F_LOCALCMD
  1608.     CASE(F_LOCALCMD);
  1609.     print_local_commands();
  1610.     push_number(0);
  1611.     break;
  1612. #endif /* F_LOCALCMD */
  1613.     CASE(F_SWAP);
  1614.     (void)swap(sp->u.ob);
  1615.     break;
  1616.     CASE(F_TRACE);
  1617.     {
  1618.         int ot = -1;
  1619.         if (command_giver && command_giver->interactive) {
  1620.         struct svalue *arg;
  1621.         push_constant_string("trace");
  1622.         arg = apply_master_ob("query_player_level", 1);
  1623.         if (arg && (arg->type != T_NUMBER || arg->u.number != 0)) {
  1624.             ot = command_giver->interactive->trace_level;
  1625.             command_giver->interactive->trace_level = sp->u.number;
  1626.         }
  1627.         }
  1628.         pop_stack();
  1629.         push_number(ot);
  1630.     }
  1631.     break;
  1632.     CASE(F_TRACEPREFIX);
  1633.     {
  1634.         char *old = 0;
  1635.  
  1636.         if (command_giver && command_giver->interactive) {
  1637.         struct svalue *arg;
  1638.         push_constant_string("trace");
  1639.         arg = apply_master_ob("query_player_level",1);
  1640.         if (arg && (arg->type != T_NUMBER || arg->u.number)) {
  1641.             old = command_giver->interactive->trace_prefix;
  1642.             if (sp->type == T_STRING) {
  1643.                 command_giver->interactive->trace_prefix = 
  1644.                 make_shared_string(sp->u.string);
  1645.                     } else
  1646.                 command_giver->interactive->trace_prefix = 0;
  1647.         }
  1648.         }
  1649.         pop_stack();
  1650.         if (old) {
  1651.         push_string(old, STRING_SHARED);   /* Will incr ref count */
  1652.         free_string(old);
  1653.         } else {
  1654.         push_number(0);
  1655.         }
  1656.     }
  1657.     break;
  1658.     CASE(F_TIME);
  1659.     push_number(current_time);
  1660.     break;
  1661.     CASE(F_WIZLIST);
  1662.     if (num_arg) {
  1663.         wizlist(sp->u.string);
  1664.     } else {
  1665.         wizlist(0);
  1666.         push_number(0);
  1667.     }
  1668.     break;
  1669. #ifdef F_TRANSFER
  1670.     CASE(F_TRANSFER);
  1671.     {
  1672.     struct object *dest;
  1673.  
  1674.     if (sp->type == T_STRING) {
  1675.         dest = find_object(sp->u.string);
  1676.         if (dest == 0)
  1677.         error("Object not found.\n");
  1678.     } else {
  1679.         dest = sp->u.ob;
  1680.     }
  1681.     i = transfer_object((sp-1)->u.ob, dest);
  1682.     pop_n_elems(2);
  1683.     push_number(i);
  1684.     break;
  1685.     }
  1686. #endif
  1687. #ifdef F_ADD_WORTH
  1688.     CASE(F_ADD_WORTH);
  1689.     if (strncmp(current_object->name, "obj/", 4) != 0 &&
  1690.         strncmp(current_object->name, "std/", 4) != 0 &&
  1691.         strncmp(current_object->name, "room/", 5) != 0)
  1692.         error("Illegal call of add_worth.\n");
  1693.     if (num_arg == 2) {
  1694.         if (sp->u.ob->user)
  1695.         sp->u.ob->user->total_worth += (sp-1)->u.number;
  1696.         pop_stack();
  1697.     } else {
  1698.         if (previous_ob == 0)
  1699.         break;
  1700.         if (previous_ob->user)
  1701.         previous_ob->user->total_worth += sp->u.number;
  1702.     }
  1703.     break;
  1704. #endif /* F_ADD_WORTH */
  1705.     CASE(F_ADD);
  1706. /*if (inadd==0) checkplus(p);*/
  1707.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  1708.         char *res;
  1709.         int l = strlen((sp-1)->u.string);
  1710.         res = xalloc(l + strlen(sp->u.string) + 1);
  1711.         (void)strcpy(res, (sp-1)->u.string);
  1712.         (void)strcpy(res+l, sp->u.string);
  1713.         pop_n_elems(2);
  1714.         push_malloced_string(res);
  1715.     } else if ((sp-1)->type == T_NUMBER && sp->type == T_STRING) {
  1716.         char buff[20], *res;
  1717.         sprintf(buff, "%d", (sp-1)->u.number);
  1718.         res = xalloc(strlen(sp->u.string) + strlen(buff) + 1);
  1719.         strcpy(res, buff);
  1720.         strcat(res, sp->u.string);
  1721.         pop_n_elems(2);
  1722.         push_malloced_string(res);
  1723.     } else if (sp->type == T_NUMBER && (sp-1)->type == T_STRING) {
  1724.         char buff[20];
  1725.         char *res;
  1726.         sprintf(buff, "%d", sp->u.number);
  1727.         res = xalloc(strlen((sp-1)->u.string) + strlen(buff) + 1);
  1728.         strcpy(res, (sp-1)->u.string);
  1729.         strcat(res, buff);
  1730.         pop_n_elems(2);
  1731.         push_malloced_string(res);
  1732.     } else if ((sp-1)->type == T_NUMBER && sp->type == T_NUMBER) {
  1733.         i = sp->u.number + (sp-1)->u.number;
  1734.         sp--;
  1735.         sp->u.number = i;
  1736.     } else if ((sp-1)->type == T_POINTER && sp->type == T_POINTER) {
  1737.         struct vector *v;
  1738.         check_for_destr((sp-1)->u.vec);
  1739.         check_for_destr(sp->u.vec);
  1740.         v = add_array((sp-1)->u.vec,sp->u.vec);
  1741.         pop_n_elems(2);
  1742.         push_vector(v); /* This will make ref count == 2 */
  1743.         v->ref--;
  1744.     } else {
  1745.         error("Bad type of arg to '+'\n");
  1746.     }
  1747.     break;
  1748.     CASE(F_SUBTRACT);
  1749.     if ((sp-1)->type == T_POINTER && sp->type == T_POINTER) {
  1750.         extern struct vector *subtract_array
  1751.           PROT((struct vector *,struct vector*));
  1752.         struct vector *v;
  1753.  
  1754.         v = sp->u.vec;
  1755.         if (v->ref > 1) {
  1756.         v = slice_array(v, 0, v->size-1 );
  1757.         v->ref--;
  1758.             }
  1759.         sp--;
  1760.         /* subtract_array already takes care of destructed objects */
  1761.         v = subtract_array(sp->u.vec, v);
  1762.         free_vector(sp->u.vec);
  1763.         sp->u.vec = v;
  1764.         break;
  1765.     }
  1766.     if ((sp-1)->type != T_NUMBER)
  1767.         bad_arg(1, F_SUBTRACT);
  1768.     if (sp->type != T_NUMBER)
  1769.         bad_arg(2, F_SUBTRACT);
  1770.     i = (sp-1)->u.number - sp->u.number;
  1771.     sp--;
  1772.     sp->u.number = i;
  1773.     break;
  1774.     CASE(F_AND);
  1775.     if (sp->type == T_POINTER && (sp-1)->type == T_POINTER) {
  1776.         extern struct vector *intersect_array
  1777.           PROT((struct vector *, struct vector *));
  1778.         (sp-1)->u.vec = intersect_array(sp->u.vec, (sp-1)->u.vec);
  1779.         sp--;
  1780.         break;
  1781.     }
  1782.     if ((sp-1)->type != T_NUMBER)
  1783.         bad_arg(1, F_AND);
  1784.     if (sp->type != T_NUMBER)
  1785.         bad_arg(2, F_AND);
  1786.     i = (sp-1)->u.number & sp->u.number;
  1787.     sp--;
  1788.     sp->u.number = i;
  1789.     break;
  1790.     CASE(F_OR);
  1791.     if ((sp-1)->type != T_NUMBER)
  1792.         bad_arg(1, F_OR);
  1793.     if (sp->type != T_NUMBER)
  1794.         bad_arg(2, F_OR);
  1795.     i = (sp-1)->u.number | sp->u.number;
  1796.     sp--;
  1797.     sp->u.number = i;
  1798.     break;
  1799.     CASE(F_XOR);
  1800.     if ((sp-1)->type != T_NUMBER)
  1801.         bad_arg(1, instruction);
  1802.     if (sp->type != T_NUMBER)
  1803.         bad_arg(2, instruction);
  1804.     i = (sp-1)->u.number ^ sp->u.number;
  1805.     sp--;
  1806.     sp->u.number = i;
  1807.     break;
  1808.     CASE(F_LSH);
  1809.     if ((sp-1)->type != T_NUMBER)
  1810.         bad_arg(1, instruction);
  1811.     if (sp->type != T_NUMBER)
  1812.         bad_arg(2, instruction);
  1813.     i = (sp-1)->u.number << sp->u.number;
  1814.     sp--;
  1815.     sp->u.number = i;
  1816.     break;
  1817.     CASE(F_RSH);
  1818.     if ((sp-1)->type != T_NUMBER)
  1819.         bad_arg(1, instruction);
  1820.     if (sp->type != T_NUMBER)
  1821.         bad_arg(2, instruction);
  1822.     i = (sp-1)->u.number >> sp->u.number;
  1823.     sp--;
  1824.     sp->u.number = i;
  1825.     break;
  1826.     CASE(F_MULTIPLY);
  1827.     if ((sp-1)->type != T_NUMBER)
  1828.         bad_arg(1, instruction);
  1829.     if (sp->type != T_NUMBER)
  1830.         bad_arg(2, instruction);
  1831.     i = (sp-1)->u.number * sp->u.number;
  1832.     sp--;
  1833.     sp->u.number = i;
  1834.     break;
  1835.     CASE(F_DIVIDE);
  1836.     if ((sp-1)->type != T_NUMBER)
  1837.         bad_arg(1, instruction);
  1838.     if (sp->type != T_NUMBER)
  1839.         bad_arg(2, instruction);
  1840.     if (sp->u.number == 0)
  1841.         error("Division by zero\n");
  1842.     i = (sp-1)->u.number / sp->u.number;
  1843.     sp--;
  1844.     sp->u.number = i;
  1845.     break;
  1846.     CASE(F_MOD);
  1847.     if ((sp-1)->type != T_NUMBER)
  1848.         bad_arg(1, instruction);
  1849.     if (sp->type != T_NUMBER)
  1850.         bad_arg(2, instruction);
  1851.     if (sp->u.number == 0)
  1852.         error("Modulus by zero.\n");
  1853.     i = (sp-1)->u.number % sp->u.number;
  1854.     sp--;
  1855.     sp->u.number = i;
  1856.     break;
  1857.     CASE(F_GT);
  1858.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  1859.         i = strcmp((sp-1)->u.string, sp->u.string) > 0;
  1860.         pop_n_elems(2);
  1861.         push_number(i);
  1862.         break;
  1863.     }
  1864.     if ((sp-1)->type != T_NUMBER)
  1865.         bad_arg(1, instruction);
  1866.     if (sp->type != T_NUMBER)
  1867.         bad_arg(2, instruction);
  1868.     i = (sp-1)->u.number > sp->u.number;
  1869.     sp--;
  1870.     sp->u.number = i;
  1871.     break;
  1872.     CASE(F_GE);
  1873.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  1874.         i = strcmp((sp-1)->u.string, sp->u.string) >= 0;
  1875.         pop_n_elems(2);
  1876.         push_number(i);
  1877.         break;
  1878.     }
  1879.     if ((sp-1)->type != T_NUMBER)
  1880.         bad_arg(1, instruction);
  1881.     if (sp->type != T_NUMBER)
  1882.         bad_arg(2, instruction);
  1883.     i = (sp-1)->u.number >= sp->u.number;
  1884.     sp--;
  1885.     sp->u.number = i;
  1886.     break;
  1887.     CASE(F_LT);
  1888.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  1889.         i = strcmp((sp-1)->u.string, sp->u.string) < 0;
  1890.         pop_n_elems(2);
  1891.         push_number(i);
  1892.         break;
  1893.     }
  1894.     if ((sp-1)->type != T_NUMBER)
  1895.         bad_arg(1, instruction);
  1896.     if (sp->type != T_NUMBER)
  1897.         bad_arg(2, instruction);
  1898.     i = (sp-1)->u.number < sp->u.number;
  1899.     sp--;
  1900.     sp->u.number = i;
  1901.     break;
  1902.     CASE(F_LE);
  1903.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  1904.         i = strcmp((sp-1)->u.string, sp->u.string) <= 0;
  1905.         pop_n_elems(2);
  1906.         push_number(i);
  1907.         break;
  1908.     }
  1909.     if ((sp-1)->type != T_NUMBER)
  1910.         bad_arg(1, instruction);
  1911.     if (sp->type != T_NUMBER)
  1912.         bad_arg(2, instruction);
  1913.     i = (sp-1)->u.number <= sp->u.number;
  1914.     sp--;
  1915.     sp->u.number = i;
  1916.     break;
  1917.     CASE(F_EQ);
  1918.     if ((sp-1)->type != sp->type) {
  1919.         pop_stack();
  1920.         assign_svalue(sp, &const0);
  1921.         break;
  1922.     }
  1923.     switch(sp->type) {
  1924.     case T_NUMBER:
  1925.         i = (sp-1)->u.number == sp->u.number;
  1926.         break;
  1927.     case T_POINTER:
  1928.         i = (sp-1)->u.vec == sp->u.vec;
  1929.         break;
  1930.     case T_STRING:
  1931.         i = strcmp((sp-1)->u.string, sp->u.string) == 0;
  1932.         break;
  1933.     case T_OBJECT:
  1934.         i = (sp-1)->u.ob == sp->u.ob;
  1935.         break;
  1936.     default:
  1937.         i = 0;
  1938.         break;
  1939.     }
  1940.     pop_n_elems(2);
  1941.     push_number(i);
  1942.     break;
  1943.     CASE(F_NE);
  1944.     if ((sp-1)->type != sp->type) {
  1945.         pop_stack();
  1946.         assign_svalue(sp, &const1);
  1947.         break;
  1948.     }
  1949.     switch(sp->type) {
  1950.     case T_NUMBER:
  1951.         i = (sp-1)->u.number != sp->u.number;
  1952.         break;
  1953.     case T_STRING:
  1954.         i = strcmp((sp-1)->u.string, sp->u.string);
  1955.         break;
  1956.     case T_POINTER:
  1957.         i = (sp-1)->u.vec != sp->u.vec;
  1958.         break;
  1959.     case T_OBJECT:
  1960.         i = (sp-1)->u.ob != sp->u.ob;
  1961.         break;
  1962.     default:
  1963.         fatal("Illegal type to !=\n");
  1964.     }
  1965.     pop_n_elems(2);
  1966.     push_number(i);
  1967.     break;
  1968. #ifdef F_LOG_FILE
  1969.     CASE(F_LOG_FILE);
  1970.     log_file((sp-1)->u.string, sp->u.string);
  1971.     pop_stack();
  1972.     break;    /* Return first argument */
  1973. #endif /* F_LOG_FILE */
  1974.     CASE(F_NOT);
  1975.     if (sp->type == T_NUMBER && sp->u.number == 0)
  1976.         sp->u.number = 1;
  1977.     else
  1978.         assign_svalue(sp, &const0);
  1979.     break;
  1980.     CASE(F_COMPL);
  1981.     if (sp->type != T_NUMBER)
  1982.         error("Bad argument to ~\n");
  1983.     sp->u.number = ~ sp->u.number;
  1984.     break;
  1985.     CASE(F_NEGATE);
  1986.     if (sp->type != T_NUMBER)
  1987.         error("Bad argument to unary minus\n");
  1988.     sp->u.number = - sp->u.number;
  1989.     break;
  1990.     CASE(F_INC);
  1991.     if (sp->type != T_LVALUE)
  1992.         error("Bad argument to ++\n");
  1993.     if (sp->u.lvalue->type != T_NUMBER)
  1994.         error("++ of non-numeric argument\n");
  1995.     sp->u.lvalue->u.number++;
  1996.     assign_svalue(sp, sp->u.lvalue);
  1997.     break;
  1998.     CASE(F_DEC);
  1999.     if (sp->type != T_LVALUE)
  2000.         error("Bad argument to --\n");
  2001.     if (sp->u.lvalue->type != T_NUMBER)
  2002.         error("-- of non-numeric argument\n");
  2003.     sp->u.lvalue->u.number--;
  2004.     assign_svalue(sp, sp->u.lvalue);
  2005.     break;
  2006.     CASE(F_POST_INC);
  2007.     if (sp->type != T_LVALUE)
  2008.         error("Bad argument to ++\n");
  2009.     if (sp->u.lvalue->type != T_NUMBER)
  2010.         error("++ of non-numeric argument\n");
  2011.     sp->u.lvalue->u.number++;
  2012.     assign_svalue(sp, sp->u.lvalue);
  2013.     sp->u.number--;
  2014.     break;
  2015.     CASE(F_POST_DEC);
  2016.     if (sp->type != T_LVALUE)
  2017.         error("Bad argument to --\n");
  2018.     if (sp->u.lvalue->type != T_NUMBER)
  2019.         error("-- of non-numeric argument\n");
  2020.     sp->u.lvalue->u.number--;
  2021.     assign_svalue(sp, sp->u.lvalue);
  2022.     sp->u.number++;
  2023.     break;
  2024.     CASE(F_CALL_OTHER);
  2025.     {
  2026.     struct svalue *arg, tmp;
  2027.     
  2028.     arg = sp - num_arg + 1;
  2029.     if (arg[0].type == T_OBJECT)
  2030.         ob = arg[0].u.ob;
  2031.     else {
  2032.         ob = find_object(arg[0].u.string);
  2033.         if (ob == 0)
  2034.         error("call_other() failed\n");
  2035.     }
  2036.     if (current_object->flags & O_DESTRUCTED) {
  2037.         /*
  2038.          * No external calls may be done when this object is
  2039.          * destructed.
  2040.          */
  2041.         pop_n_elems(num_arg);
  2042.         push_number(0);
  2043.         break;
  2044.     }
  2045.     if (arg[1].u.string[0] == ':')
  2046.         error("Illegal function name in call_other: %s\n",
  2047.           arg[1].u.string);
  2048.     /*
  2049.      * Send the remaining arguments to the function.
  2050.      */
  2051.     if (TRACEP(TRACE_CALL_OTHER)) {
  2052.         do_trace("Call other ", arg[1].u.string, "\n");
  2053.     }
  2054.     if (apply_low(arg[1].u.string, ob, num_arg-2) == 0) {
  2055.         /* Function not found */
  2056.         pop_n_elems(2);
  2057.         push_number(0);
  2058.         break;
  2059.     }
  2060.     /*
  2061.      * The result of the function call is on the stack. But, so
  2062.      * is the function name and object that was called.
  2063.      * These have to be removed.
  2064.      */
  2065.     tmp = *sp--;    /* Copy the function call result */
  2066.     pop_n_elems(2);    /* Remove old arguments to call_other */
  2067.     *++sp = tmp;    /* Re-insert function result */
  2068.     break;
  2069.     }
  2070.     CASE(F_INTP);
  2071.     if (sp->type == T_NUMBER)
  2072.         assign_svalue(sp, &const1);
  2073.     else
  2074.         assign_svalue(sp, &const0);
  2075.     break;
  2076.     CASE(F_STRINGP);
  2077.     if (sp->type == T_STRING)
  2078.         assign_svalue(sp, &const1);
  2079.     else
  2080.         assign_svalue(sp, &const0);
  2081.     break;
  2082.     CASE(F_OBJECTP);
  2083.     if (sp->type == T_OBJECT)
  2084.         assign_svalue(sp, &const1);
  2085.     else
  2086.         assign_svalue(sp, &const0);
  2087.     break;
  2088.     CASE(F_POINTERP);
  2089.     if (sp->type == T_POINTER)
  2090.         assign_svalue(sp, &const1);
  2091.     else
  2092.         assign_svalue(sp, &const0);
  2093.     break;
  2094.     CASE(F_EXTRACT);
  2095.     {
  2096.     int len, from, to;
  2097.     struct svalue *arg;
  2098.     char *res;
  2099.  
  2100.     arg = sp - num_arg + 1;
  2101.     len = strlen(arg[0].u.string);
  2102.     if (num_arg == 1)
  2103.         break;        /* Simply return argument */
  2104.     from = arg[1].u.number;
  2105.     if (from < 0)
  2106.         from = len + from;
  2107.     if (from >= len) {
  2108.         pop_n_elems(num_arg);
  2109.         push_string("", STRING_CONSTANT);
  2110.         break;
  2111.     }
  2112.     if (num_arg == 2) {
  2113.         res = string_copy(arg->u.string + from);
  2114.         pop_n_elems(2);
  2115.         push_malloced_string(res);
  2116.         break;
  2117.     }
  2118.     if (arg[2].type != T_NUMBER)
  2119.         error("Bad third argument to extract()\n");
  2120.     to = arg[2].u.number;
  2121.     if (to < 0)
  2122.         to = len + to;
  2123.     if (to < from) {
  2124.         pop_n_elems(3);
  2125.         push_string("", STRING_CONSTANT);
  2126.         break;
  2127.     }
  2128.     if (to >= len)
  2129.         to = len-1;
  2130.     if (to == len-1) {
  2131.         res = string_copy(arg->u.string + from);
  2132.         pop_n_elems(3);
  2133.         push_malloced_string(res);
  2134.         break;
  2135.     }
  2136.     res = xalloc(to - from + 2);
  2137.     strncpy(res, arg[0].u.string + from, to - from + 1);
  2138.     res[to - from + 1] = '\0';
  2139.     pop_n_elems(3);
  2140.     push_malloced_string(res);
  2141.     break;
  2142.     }
  2143.     CASE(F_RANGE);
  2144.     {
  2145.     if (sp[-1].type != T_NUMBER)
  2146.         error("Bad type of start interval to [ .. ] range.\n");
  2147.     if (sp[0].type != T_NUMBER)
  2148.         error("Bad type of end interval to [ .. ] range.\n");
  2149.     if (sp[-2].type == T_POINTER) {
  2150.         struct vector *v;
  2151.  
  2152.         v = slice_array(sp[-2].u.vec, sp[-1].u.number, sp[0].u.number);
  2153.         pop_n_elems(3);
  2154.         if (v) {
  2155.         push_vector(v);
  2156.         v->ref--;    /* Will make ref count == 1 */
  2157.         } else {
  2158.         push_number(0);
  2159.         }
  2160.     } else if (sp[-2].type == T_STRING) {
  2161.         int len, from, to;
  2162.         char *res;
  2163.         
  2164.         len = strlen(sp[-2].u.string);
  2165.         from = sp[-1].u.number;
  2166.         if (from < 0)
  2167.         from = len + from;
  2168.         if (from >= len) {
  2169.         pop_n_elems(3);
  2170.         push_string("", STRING_CONSTANT);
  2171.         break;
  2172.         }
  2173.         to = sp[0].u.number;
  2174.         if (to < 0)
  2175.         to = len + to;
  2176.         if (to < from) {
  2177.         pop_n_elems(3);
  2178.         push_string("", STRING_CONSTANT);
  2179.         break;
  2180.         }
  2181.         if (to >= len)
  2182.         to = len-1;
  2183.         if (to == len-1) {
  2184.         res = string_copy(sp[-2].u.string + from);
  2185.         pop_n_elems(3);
  2186.         push_malloced_string(res);
  2187.         break;
  2188.         }
  2189.         res = xalloc(to - from + 2);
  2190.         strncpy(res, sp[-2].u.string + from, to - from + 1);
  2191.         res[to - from + 1] = '\0';
  2192.         pop_n_elems(3);
  2193.         push_malloced_string(res);
  2194.     } else {
  2195.         error("Bad argument to [ .. ] range operand.\n");
  2196.     }
  2197.     break;
  2198.     }
  2199.     CASE(F_QUERY_VERB);
  2200.     if (last_verb == 0) {
  2201.         push_number(0);
  2202.         break;
  2203.     }
  2204.     push_string(last_verb, STRING_CONSTANT);
  2205.     break;
  2206.     CASE(F_EXEC);
  2207.  
  2208.     i = replace_interactive((sp-1)->u.ob, sp->u.ob, current_prog->name);
  2209.     pop_stack();
  2210.     pop_stack();
  2211.     push_number(i);
  2212.     break;
  2213.  
  2214.     CASE(F_FILE_NAME);
  2215.     {
  2216.     char *name,*res;
  2217.  
  2218.     /* This function now returns a leading '/', except when -o flag */
  2219.     name = sp->u.ob->name;
  2220. #ifdef COMPAT_MODE
  2221.     res = string_copy(name);
  2222. #else
  2223.     res = add_slash(name);
  2224. #endif    
  2225.     pop_stack();
  2226.     push_malloced_string(res);
  2227.     break;
  2228.     }
  2229.     CASE(F_USERS);
  2230.     push_vector(users());    /* users() has already set ref count to 1 */
  2231.     sp->u.vec->ref--;
  2232.     break;
  2233.     CASE(F_CALL_OUT);
  2234.     {
  2235.         struct svalue *arg = sp - num_arg + 1;
  2236.  
  2237.         if (!(current_object->flags & O_DESTRUCTED))
  2238.         new_call_out(current_object, arg[0].u.string, arg[1].u.number,
  2239.                  num_arg == 3 ? sp : 0);
  2240.         pop_n_elems(num_arg);
  2241.         push_number(0);
  2242.     }
  2243.     break;
  2244.     CASE(F_CALL_OUT_INFO);
  2245.     push_vector(get_all_call_outs());
  2246.     sp->u.vec->ref--;    /* Was set to 1 at allocation */
  2247.     break;
  2248.     CASE(F_REMOVE_CALL_OUT);
  2249.     i = remove_call_out(current_object, sp->u.string);
  2250.     pop_stack();
  2251.     push_number(i);
  2252.     break;
  2253.     CASE(F_FIND_CALL_OUT);
  2254.         i = find_call_out(current_object, sp->u.string);
  2255.       pop_stack();
  2256.     push_number(i);
  2257.         break;
  2258. #ifdef F_INHERIT_LIST
  2259.     CASE(F_INHERIT_LIST)
  2260.     {
  2261.     struct vector *vec;
  2262.     extern struct vector *inherit_list PROT((struct object *));
  2263.  
  2264.     vec = inherit_list(sp->u.ob);
  2265.     pop_stack();
  2266.     push_vector(vec);
  2267.     break;
  2268.     }
  2269. #endif /* F_INHERIT_LIST */
  2270.     CASE(F_WRITE);
  2271.     do_write(sp);
  2272.     break;
  2273.     CASE (F_MEMBER_ARRAY);
  2274.     {
  2275.     struct vector *v;
  2276.  
  2277.     v = sp->u.vec;
  2278.     check_for_destr(v);
  2279.     for (i=0; i < v->size; i++) {
  2280.         if (v->item[i].type != (sp-1)->type)
  2281.         continue;
  2282.         switch((sp-1)->type) {
  2283.         case T_STRING:
  2284.         if (strcmp((sp-1)->u.string, v->item[i].u.string) == 0)
  2285.             break;
  2286.         continue;
  2287.         case T_POINTER:
  2288.         if ((sp-1)->u.vec == v->item[i].u.vec)
  2289.             break;
  2290.         continue;
  2291.         case T_OBJECT:
  2292.         if ((sp-1)->u.ob == v->item[i].u.ob)
  2293.             break;
  2294.         continue;
  2295.         case T_NUMBER:
  2296.         if ((sp-1)->u.number == v->item[i].u.number)
  2297.             break;
  2298.         continue;
  2299.         default:
  2300.         fatal("Bad type to member_array(): %d\n", (sp-1)->type);
  2301.         }
  2302.         break;
  2303.     }
  2304.     if (i == v->size)
  2305.         i = -1;        /* Return -1 for failure */
  2306.     pop_n_elems(2);
  2307.     push_number(i);
  2308.     break;
  2309.     }
  2310.     CASE(F_MOVE_OBJECT);
  2311.     {
  2312.     struct object *o1, *o2;
  2313.  
  2314.     if ((sp-1)->type == T_OBJECT)
  2315.         o1 = (sp-1)->u.ob;
  2316.     else {
  2317.         o1 = find_object((sp-1)->u.string);
  2318.         if (o1 == 0)
  2319.         error("move_object failed\n");
  2320.     }
  2321.     if (sp->type == T_OBJECT)
  2322.         o2 = sp->u.ob;
  2323.     else {
  2324.         o2 = find_object(sp->u.string);
  2325.         if (o2 == 0)
  2326.         error("move_object failed\n");
  2327.     }
  2328.     move_object(o1, o2);
  2329.     pop_stack();
  2330.     break;
  2331.     }
  2332.     CASE(F_FUNCTION_EXISTS);
  2333.     {
  2334.     char *str, *res;
  2335.  
  2336.     str = function_exists((sp-1)->u.string, sp->u.ob);
  2337.     pop_n_elems(2);
  2338.     if (str) {
  2339. #ifdef COMPAT_MODE
  2340.         res = string_copy (str); /* Marion sighs deeply. */
  2341. #else
  2342.         res = add_slash(str);
  2343. #endif
  2344.         if (str = strrchr (res, '.'))
  2345.         *str = 0;
  2346.         push_malloced_string(res);
  2347.     } else {
  2348.         push_number(0);
  2349.     }
  2350.     break;
  2351.     }
  2352.     CASE(F_SNOOP);
  2353.     /* This one takes a variable number of arguments. It returns
  2354.      * 0 or an object.
  2355.      */
  2356. #ifdef COMPAT_MODE
  2357.     if (!command_giver || num_arg == 2) {
  2358.         pop_n_elems (num_arg);
  2359.         push_number (0);
  2360.     } else {
  2361.         if (num_arg == 0) {
  2362.         set_snoop(command_giver, 0);
  2363.         push_number(0);
  2364.         } else {
  2365.         /* The argument object is returned. */
  2366.         set_snoop(command_giver, sp->u.ob);
  2367.         }
  2368.     }
  2369. #else
  2370.     if (!command_giver) {
  2371.         pop_n_elems(num_arg);
  2372.         push_number(0);
  2373.     } else {
  2374.         ob = 0; /* Do not remove this, it is not 0 by default */
  2375.         switch (num_arg) {
  2376.         case 1:
  2377.         if (new_set_snoop(sp->u.ob, 0))
  2378.             ob = sp->u.ob;
  2379.         break;
  2380.         case 2:
  2381.         if (new_set_snoop((sp-1)->u.ob, sp->u.ob))
  2382.             ob = sp->u.ob;
  2383.         break;
  2384.         default:
  2385.         ob = 0;
  2386.         break;
  2387.         }
  2388.         pop_n_elems(num_arg);
  2389.         if (ob)
  2390.         push_object(ob);
  2391.         else
  2392.         push_number(0);
  2393.     }
  2394. #endif
  2395.     break;
  2396.     CASE(F_ADD_ACTION);
  2397.     {
  2398.     struct svalue *arg = sp - num_arg + 1;
  2399.     if (num_arg == 3) {
  2400.         if (arg[2].type != T_NUMBER)
  2401.         bad_arg(3, instruction);
  2402.     }
  2403.     add_action(arg[0].u.string,
  2404.            num_arg > 1 ? arg[1].u.string : 0,
  2405.            num_arg > 2 ? arg[2].u.number : 0);
  2406.     pop_n_elems(num_arg-1);
  2407.     break;
  2408.     }
  2409. #ifdef F_ADD_VERB
  2410.     CASE(F_ADD_VERB);
  2411.     add_verb(sp->u.string,0);
  2412.     break;
  2413. #endif /* F_ADD_VERB */
  2414. #ifdef F_ADD_XVERB
  2415.     CASE(F_ADD_XVERB);
  2416.        add_verb(sp->u.string,1);
  2417.     break;
  2418. #endif /* F_ADD_XVERB */
  2419.     CASE(F_ALLOCATE);
  2420.     {
  2421.     struct vector *v;
  2422.  
  2423.     v = allocate_array(sp->u.number);    /* Will have ref count == 1 */
  2424.     pop_stack();
  2425.     push_vector(v);
  2426.     v->ref--;
  2427.     break;
  2428.     }
  2429.     CASE(F_ED);
  2430.     if (num_arg == 0) {
  2431.         struct svalue *arg;
  2432.         char *err_file;
  2433.  
  2434.         if (command_giver == 0 || command_giver->interactive == 0) {
  2435.         push_number(0);
  2436.         break;
  2437.         }
  2438.         arg = sapply("query_real_name", command_giver, 0);
  2439.         if (arg == 0 || arg->type != T_STRING) {
  2440.         push_number(0);
  2441.         break;
  2442.         }
  2443.         err_file = get_error_file(arg->u.string);
  2444.         if (err_file == 0) {
  2445.         push_number(0);
  2446.         break;
  2447.         }
  2448.         ed_start(err_file, 0, 0);
  2449.         push_number(1);
  2450.         break;
  2451.     } else if (num_arg == 1) {
  2452.         ed_start(sp->u.string, 0, 0);
  2453.     } else {
  2454.         if (sp->type == T_STRING)
  2455.             ed_start((sp-1)->u.string, sp->u.string, current_object);
  2456.         else
  2457.         ed_start((sp-1)->u.string, 0 , 0);
  2458.         pop_stack();
  2459.     }
  2460.     break;
  2461.     CASE(F_CRYPT);
  2462.     {
  2463.     char salt[2];
  2464.     char *res;
  2465.     char *choise =
  2466.         "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789./";
  2467.  
  2468.     if (sp->type == T_STRING && strlen(sp->u.string) >= 2) {
  2469.         salt[0] = sp->u.string[0];
  2470.         salt[1] = sp->u.string[1];
  2471.     } else {
  2472.         salt[0] = choise[random_number(strlen(choise))];
  2473.         salt[1] = choise[random_number(strlen(choise))];
  2474.     }
  2475. #ifdef sun
  2476.     res = string_copy(_crypt((sp-1)->u.string, salt));
  2477. #else
  2478.     res = string_copy(crypt((sp-1)->u.string, salt));
  2479. #endif
  2480.     pop_n_elems(2);
  2481.     push_malloced_string(res);
  2482.     break;
  2483.     }
  2484. #ifdef F_CREATE_WIZARD
  2485.     CASE(F_CREATE_WIZARD);
  2486.     {
  2487.     char *str;
  2488.     struct svalue *arg = sp - num_arg + 1;
  2489.     str = create_wizard(arg[0].u.string,
  2490.                 num_arg == 2 ? arg[1].u.string : 0);
  2491.     pop_n_elems(num_arg);
  2492.     if (str)
  2493.         push_string(str, STRING_MALLOC);
  2494.     else
  2495.         push_number(0);
  2496.     break;
  2497.     }
  2498. #endif
  2499.     CASE(F_DESTRUCT);
  2500.     destruct_object(sp);
  2501.     break;
  2502.     CASE(F_RANDOM);
  2503.     if (sp->u.number <= 0) {
  2504.         sp->u.number = 0;
  2505.         break;
  2506.     }
  2507.     sp->u.number = random_number(sp->u.number);
  2508.     break;
  2509. #ifdef F_SAY
  2510.     CASE(F_SAY);
  2511.     {
  2512.     static struct {
  2513.         struct vector v;
  2514.         struct svalue second_item[1];
  2515.     } vtmp = { { 2, 1,
  2516. #ifdef DEBUG
  2517.              1,
  2518. #endif
  2519.              (struct wiz_list *)NULL,
  2520.          { { T_NUMBER } } }, { { T_OBJECT } }
  2521.            };
  2522.     
  2523.     if (num_arg == 1) {
  2524.         vtmp.v.item[0].type = T_NUMBER; /* this marks the place for the
  2525.                            command_giver
  2526.                            */
  2527.         vtmp.v.item[1].type = T_NUMBER; /* will not match any object... */
  2528.         say(sp, &vtmp.v);
  2529.     } else {
  2530.         if ( sp->type == T_POINTER ) {
  2531.         if (sp->u.vec->ref > 1) {
  2532.             struct vector *vtmpp =
  2533.             slice_array(sp->u.vec, 0, sp->u.vec->size-1);
  2534.             say(sp-1, vtmpp);
  2535.             free_vector(vtmpp);
  2536.         } else
  2537.                 say(sp-1, sp->u.vec);
  2538.         } else {
  2539.             vtmp.v.item[0].type = T_NUMBER;
  2540.         vtmp.v.item[1].type = T_OBJECT;
  2541.             vtmp.v.item[1].u.ob = sp->u.ob;
  2542.         add_ref(sp->u.ob, "say");
  2543.             say(sp-1, &vtmp.v);
  2544.         }
  2545.         pop_stack();
  2546.     }
  2547.     break;
  2548.     }
  2549. #endif /* F_SAY */
  2550. #ifdef F_TELL_ROOM
  2551.     CASE(F_TELL_ROOM);
  2552.     {
  2553.     extern struct vector null_vector;
  2554.     struct svalue *arg = sp- num_arg + 1;
  2555.     struct vector *avoid;
  2556.  
  2557.     if (arg[0].type == T_OBJECT)
  2558.         ob = arg[0].u.ob;
  2559.     else {
  2560.         ob = find_object(arg[0].u.string);
  2561.         if (ob == 0)
  2562.         error("Object not found.\n");
  2563.     }
  2564.     if (num_arg == 2) {
  2565.         avoid = &null_vector;
  2566.         avoid->ref++;
  2567.     } else {
  2568.         extern struct vector *order_alist PROT((struct vector *));
  2569.         struct vector *vtmpp;
  2570.         static struct vector vtmp = { 1, 1,
  2571. #ifdef DEBUG
  2572.         1,
  2573. #endif
  2574.         (struct wiz_list *)NULL,
  2575.         { { T_POINTER } }
  2576.         };
  2577.  
  2578.         if (arg[2].type != T_POINTER)
  2579.         bad_arg(3, instruction);
  2580.         vtmp.item[0].u.vec = arg[2].u.vec;
  2581.         if (vtmp.item[0].u.vec->ref > 1) {
  2582.         vtmp.item[0].u.vec->ref--;
  2583.         vtmp.item[0].u.vec = slice_array(
  2584.           vtmp.item[0].u.vec, 0, vtmp.item[0].u.vec->size-1);
  2585.         }
  2586.         sp--;
  2587.         vtmpp = order_alist(&vtmp);
  2588.         avoid = vtmpp->item[0].u.vec;
  2589.         vtmpp->item[0].u.vec = vtmp.item[0].u.vec;
  2590.         free_vector(vtmpp);
  2591.     }
  2592.     tell_room(ob, sp, avoid);
  2593.     free_vector(avoid);
  2594.     pop_stack();
  2595.     break;
  2596.     }
  2597. #endif /* F_TELL_ROOM */
  2598. #ifdef F_SHOUT
  2599.     CASE(F_SHOUT);
  2600.     shout_string(sp->u.string);
  2601.     break;
  2602. #endif /* F_SHOUT */
  2603.     CASE(F_WHILE);
  2604.     fatal("F_WHILE should not appear.\n");
  2605.     CASE(F_DO);
  2606.     fatal("F_DO should not appear.\n");
  2607.     CASE(F_FOR);
  2608.     fatal("F_FOR should not appear.\n");
  2609.     CASE(F_SWITCH);
  2610.     {
  2611.     extern char* findstring PROT((char*));
  2612.     unsigned short offset,break_adr;
  2613.     int d,s,r;
  2614.     char *l,*end_tab;
  2615.     static short off_tab[] = { 0*6,1*6,3*6,7*6,15*6,31*6,63*6,127*6,255*6,
  2616.                     511*6,1023*6,2047*6,4095*6,8191*6 };
  2617.  
  2618.     ((char *)&offset)[0] = pc[1];
  2619.     ((char *)&offset)[1] = pc[2];
  2620.     ((char *)&break_adr)[0] = pc[3];
  2621.     ((char *)&break_adr)[1] = pc[4];
  2622.     *--break_sp = break_adr;
  2623.     if ( ( i = EXTRACT_UCHAR(pc) >> 4 ) != 0xf ) {
  2624.         if ( sp->type == T_NUMBER && !sp->u.number ) {
  2625.         /* special case: uninitalized string */
  2626.         s = ZERO_AS_STR_CASE_LABEL;
  2627.         } else if ( sp->type == T_STRING ) {
  2628.             switch(sp->string_type) {
  2629.             case STRING_SHARED:
  2630.                 s = (int)sp->u.string;
  2631.                 break;
  2632.         default:
  2633.             s = (int)findstring(sp->u.string);
  2634.                 break;
  2635.             }
  2636.         } else {
  2637.         bad_arg(1, F_SWITCH);
  2638.         }
  2639.     } else {
  2640.         if (sp->type != T_NUMBER) bad_arg(1, F_SWITCH);
  2641.         s = sp->u.number;
  2642.         i = (int)pc[0] &0xf ;
  2643.     }
  2644.     pop_stack();
  2645.     end_tab = current_prog->program + break_adr;
  2646.     if ( i >= 14 )
  2647.         if ( i == 14 ) {
  2648.         /* fastest switch format : lookup table */
  2649.             l = current_prog->program + offset;
  2650.                 ((char *)&d)[0] = end_tab[-4];
  2651.                 ((char *)&d)[1] = end_tab[-3];
  2652.                 ((char *)&d)[2] = end_tab[-2];
  2653.                 ((char *)&d)[3] = end_tab[-1];
  2654.         if ( s >= d && l + (s=(s-d)*sizeof(short)) < end_tab - 4 ) {
  2655.             ((char *)&offset)[0] = l[s];
  2656.             ((char *)&offset)[1] = l[s+1];
  2657.             if (offset) {
  2658.             pc = current_prog->program + offset;
  2659.             break;
  2660.             }
  2661.         }
  2662.         /* default */
  2663.         ((char *)&offset)[0] = pc[5];
  2664.         ((char *)&offset)[1] = pc[6];
  2665.         pc = current_prog->program + offset;
  2666.         break;
  2667.         } else
  2668.         fatal("unsupported switch table format.\n");
  2669.     l = current_prog->program + offset + off_tab[i];
  2670.     d = (off_tab[i]+6) >> 1;
  2671.     if (d == 3) d=0;
  2672.     for(;;) {
  2673.         ((char *)&r)[0] = l[0];
  2674.         ((char *)&r)[1] = l[1];
  2675.         ((char *)&r)[2] = l[2];
  2676.         ((char *)&r)[3] = l[3];
  2677.         if (s < r)
  2678.                 if (d < 6) {
  2679.                     if (!d) { /* test for range */
  2680.             ((char *)&offset)[0] = l[-2];
  2681.             ((char *)&offset)[1] = l[-1];
  2682.  
  2683.             /* F_BREAK is required to be > 1 */
  2684.             if (offset <= 1) {
  2685.                     ((char *)&r)[0] = l[-6];
  2686.                     ((char *)&r)[1] = l[-5];
  2687.                     ((char *)&r)[2] = l[-4];
  2688.                     ((char *)&r)[3] = l[-3];
  2689.                 if (s >= r) {
  2690.                 /* s is in the range */
  2691.                 if (!offset) {
  2692.                     /* range with lookup table */
  2693.                                     ((char *)&offset)[0] = l[4];
  2694.                                     ((char *)&offset)[1] = l[5];
  2695.                     l = current_prog->program + offset +
  2696.                     (s-r) * sizeof(short);
  2697.                                     ((char *)&offset)[0] = l[0];
  2698.                                     ((char *)&offset)[1] = l[1];
  2699.                     break;
  2700.                 }
  2701.                 ((char *)&offset)[0] = l[4];
  2702.                 ((char *)&offset)[1] = l[5];
  2703.                 break;
  2704.                 }
  2705.             }
  2706.             /* use default address */
  2707.                         ((char *)&offset)[0] = pc[5];
  2708.                         ((char *)&offset)[1] = pc[6];
  2709.                         break;
  2710.                     } /* !d */
  2711.                     d = 0;
  2712.                 } else {
  2713.             /* d >= 6 */
  2714.                     l -= d;
  2715.                     d >>= 1;
  2716.         }
  2717.         else if (s > r) {
  2718.                 if (d < 6) {
  2719.                     if (!d) { /* test for range */
  2720.             ((char *)&offset)[0] = l[4];
  2721.             ((char *)&offset)[1] = l[5];
  2722.             if (offset <= 1) {
  2723.                     ((char *)&r)[0] = l[6];
  2724.                     ((char *)&r)[1] = l[7];
  2725.                     ((char *)&r)[2] = l[8];
  2726.                     ((char *)&r)[3] = l[9];
  2727.                 if (s <= r) {
  2728.                 /* s is in the range */
  2729.                 if (!offset) {
  2730.                     /* range with lookup table */
  2731.                                     ((char *)&offset)[0] = l[10];
  2732.                                     ((char *)&offset)[1] = l[11];
  2733.                     l = current_prog->program + offset +
  2734.                     (s-r) * sizeof(short);
  2735.                                     ((char *)&offset)[0] = l[0];
  2736.                                     ((char *)&offset)[1] = l[1];
  2737.                     break;
  2738.                 }
  2739.                 ((char *)&offset)[0] = l[10];
  2740.                 ((char *)&offset)[1] = l[11];
  2741.                 break;
  2742.                 }
  2743.             }
  2744.             /* use default address */
  2745.                         ((char *)&offset)[0] = pc[5];
  2746.                         ((char *)&offset)[1] = pc[6];
  2747.                         break;
  2748.                     } /* !d */
  2749.                     d = 0;
  2750.                 } else {
  2751.             /* d >= 6 */
  2752.                     l += d;
  2753.                     while (l >= end_tab) {
  2754.                         d >>= 1;
  2755.                         if (d <= 3) {
  2756.                             if (!d) break;
  2757.                             d = 0;
  2758.                         }
  2759.                         l -= d;
  2760.                     }
  2761.             d >>= 1;
  2762.         }
  2763.         } else {
  2764.         /* s == r */
  2765.         ((char *)&offset)[0] = l[4];
  2766.         ((char *)&offset)[1] = l[5];
  2767.         if ( !l[-2] && !l[-1] ) {
  2768.             /* end of range with lookup table */
  2769.             ((char *)&r)[0] = l[-6];
  2770.             ((char *)&r)[1] = l[-5];
  2771.             ((char *)&r)[2] = l[-4];
  2772.             ((char *)&r)[3] = l[-3];
  2773.             l = current_prog->program + offset + (s-r)*sizeof(short);
  2774.                     ((char *)&offset)[0] = l[0];
  2775.                     ((char *)&offset)[1] = l[1];
  2776.         }
  2777.         if (offset <= 1) {
  2778.             if (!offset) {
  2779.             /* start of range with lookup table */
  2780.                         ((char *)&offset)[0] = l[10];
  2781.                         ((char *)&offset)[1] = l[11];
  2782.             l = current_prog->program + offset;
  2783.                         ((char *)&offset)[0] = l[0];
  2784.                         ((char *)&offset)[1] = l[1];
  2785.             } else {
  2786.                         ((char *)&offset)[0] = l[10];
  2787.                         ((char *)&offset)[1] = l[11];
  2788.             }
  2789.         }
  2790.         break;
  2791.         }
  2792.     }
  2793.     pc = current_prog->program + offset;
  2794.     break;
  2795.     }
  2796.     CASE(F_BREAK);
  2797.     {
  2798.     pc = current_prog->program + *break_sp++;
  2799.     break;
  2800.     }
  2801.     CASE(F_SUBSCRIPT);
  2802.     fatal("F_SUBSCRIPT should not appear.\n");
  2803.     CASE(F_STRLEN);
  2804.     i = strlen(sp->u.string);
  2805.     pop_stack();
  2806.     push_number(i);
  2807.     break;
  2808.     CASE(F_SIZEOF);
  2809.     i = sp->u.vec->size;
  2810.     pop_stack();
  2811.     push_number(i);
  2812.     break;
  2813.     CASE(F_LOWER_CASE);
  2814.     {
  2815.     char *str = string_copy(sp->u.string);
  2816.     for (i = strlen(str)-1; i>=0; i--)
  2817.         if (isalpha(str[i]))
  2818.         str[i] |= 'a' - 'A';
  2819.     pop_stack();
  2820.     push_malloced_string(str);
  2821.     break;
  2822.     }
  2823.     CASE(F_SET_HEART_BEAT);
  2824.     i = set_heart_beat(current_object, sp->u.number);
  2825.     sp->u.number = i;
  2826.     break;
  2827.     CASE(F_CAPITALIZE);
  2828.     if (islower(sp->u.string[0])) {
  2829.         char *str;
  2830.  
  2831.         str = string_copy(sp->u.string);
  2832.         str[0] += 'A' - 'a';
  2833.         pop_stack();
  2834.         push_malloced_string(str);
  2835.     }
  2836.     break;
  2837.     CASE(F_PROCESS_STRING);
  2838.     {
  2839.     extern char
  2840.         *process_string PROT((char *));
  2841.  
  2842.     char *str;
  2843.  
  2844.     str = process_string(sp->u.string);
  2845.     if (str != sp->u.string) {
  2846.         pop_stack();
  2847.         push_malloced_string(str);
  2848.     }
  2849.     break;
  2850.     }
  2851.     CASE(F_COMMAND);
  2852.     {
  2853.     struct svalue *arg = sp - num_arg + 1;
  2854.  
  2855.     if (num_arg == 1)
  2856.         i = command_for_object(arg[0].u.string, 0);
  2857.     else
  2858. #ifdef COMPAT_MODE
  2859.         i = command_for_object(arg[0].u.string, arg[1].u.ob);
  2860. #else
  2861.         error("Too many arguments to command()\n");
  2862. #endif
  2863.     pop_n_elems(num_arg);
  2864.     push_number(i);
  2865.     break;
  2866.     }
  2867.     CASE(F_GET_DIR);
  2868.     {
  2869.     struct vector *v = get_dir(sp->u.string);
  2870.     pop_stack();
  2871.     if (v) {
  2872.         push_vector(v);
  2873.         v->ref--;    /* Will now be 1. */
  2874.     } else
  2875.         push_number(0);
  2876.     break;
  2877.     }
  2878.     CASE(F_RM);
  2879.     i = remove_file(sp->u.string);
  2880.     pop_stack();
  2881.     push_number(i);
  2882.     break;
  2883.     CASE(F_CAT);
  2884.     {
  2885.     struct svalue *arg = sp- num_arg + 1;
  2886.     int start = 0, len = 0;
  2887.  
  2888.     if (num_arg > 1)
  2889.         start = arg[1].u.number;
  2890.     if (num_arg == 3) {
  2891.         if (arg[2].type != T_NUMBER)
  2892.         bad_arg(2, instruction);
  2893.         len = arg[2].u.number;
  2894.     }
  2895.     i = print_file(arg[0].u.string, start, len);
  2896.     pop_n_elems(num_arg);
  2897.     push_number(i);
  2898.     break;
  2899.     }
  2900.     CASE(F_MKDIR);
  2901.     {
  2902.     char *path;
  2903.  
  2904. #ifdef COMPAT_MODE
  2905.     path = check_file_name(sp->u.string, 1);
  2906. #else
  2907.     path = check_valid_path(sp->u.string, current_object->eff_user, "mkdir", 1);
  2908. #endif    
  2909.     /* pop_stack(); see comment above... */
  2910.     if (path == 0 || mkdir(path, 0770) == -1)
  2911.         assign_svalue(sp, &const0);
  2912.     else
  2913.         assign_svalue(sp, &const1);
  2914.     break;
  2915.     }
  2916.     CASE(F_RMDIR);
  2917.     {
  2918.     char *path;
  2919.  
  2920. #ifdef COMPAT_MODE    
  2921.     path = check_file_name(sp->u.string, 1);
  2922. #else    
  2923.     path = check_valid_path(sp->u.string, current_object->eff_user, "rmdir", 1);
  2924. #endif    
  2925.     /* pop_stack(); rw - what the heck ??? */
  2926.     if (path == 0 || rmdir(path) == -1)
  2927.         assign_svalue(sp, &const0);
  2928.     else
  2929.         assign_svalue(sp, &const1);
  2930.     break;
  2931.     }
  2932.     CASE(F_INPUT_TO);
  2933.     {
  2934.     struct svalue *arg = sp - num_arg + 1;
  2935.     int flag = 1;
  2936.     
  2937.     if (num_arg == 1 || sp->type == T_NUMBER && sp->u.number == 0)
  2938.         flag = 0;
  2939.     i = input_to(arg[0].u.string, flag);
  2940.     pop_n_elems(num_arg);
  2941.     push_number(i);
  2942.     break;
  2943.     }
  2944.     CASE(F_SET_LIVING_NAME);
  2945.     set_living_name(current_object, sp->u.string);
  2946.     break;
  2947.     CASE(F_PARSE_COMMAND);
  2948.     {
  2949.     struct svalue *arg;
  2950.  
  2951.     num_arg = EXTRACT_UCHAR(pc);
  2952.     pc++;
  2953.     arg = sp - num_arg + 1;
  2954.     if (arg[0].type != T_STRING)
  2955.         bad_arg(1, F_PARSE_COMMAND);
  2956.     if (arg[1].type != T_OBJECT && arg[1].type != T_POINTER)
  2957.         bad_arg(2, F_PARSE_COMMAND);
  2958.     if (arg[2].type != T_STRING)
  2959.         bad_arg(3, F_PARSE_COMMAND);
  2960.     if (arg[1].type == T_POINTER)
  2961.         check_for_destr(arg[1].u.vec);
  2962.  
  2963.     i = parse(arg[0].u.string, &arg[1], arg[2].u.string, &arg[3],
  2964.           num_arg-3); 
  2965.     pop_n_elems(num_arg);    /* Get rid of all arguments */
  2966.     push_number(i);        /* Push the result value */
  2967.     break;
  2968.     }
  2969.     CASE(F_SSCANF);
  2970.     num_arg = EXTRACT_UCHAR(pc);
  2971.     pc++;
  2972.     i = inter_sscanf(num_arg);
  2973.     pop_n_elems(num_arg);
  2974.     push_number(i);
  2975.     break;
  2976.     CASE(F_ENABLE_COMMANDS);
  2977.     enable_commands(1);
  2978.     push_number(1);
  2979.     break;
  2980.     CASE(F_DISABLE_COMMANDS);
  2981.     enable_commands(0);
  2982.     push_number(0);
  2983.     break;
  2984.     CASE(F_PRESENT);
  2985.     {
  2986.         struct svalue *arg = sp - num_arg + 1;
  2987.         ob = object_present(arg, num_arg == 1 ? 0 : arg[1].u.ob);
  2988.         pop_n_elems(num_arg);
  2989.         if (ob)
  2990.         push_object(ob);
  2991.         else
  2992.         push_number(0);
  2993.     }
  2994.     break;
  2995. #ifdef F_SET_LIGHT
  2996.     CASE(F_SET_LIGHT);
  2997.     {
  2998.     struct object *o1;
  2999.  
  3000.     add_light(current_object, sp->u.number);
  3001.     o1 = current_object;
  3002.     while(o1->super)
  3003.         o1 = o1->super;
  3004.     sp->u.number = o1->total_light;
  3005.     break;
  3006.     }
  3007. #endif /* F_SET_LIGHT */
  3008.     CASE(F_CONST0);
  3009.     push_number(0);
  3010.     break;
  3011.     CASE(F_CONST1);
  3012.     push_number(1);
  3013.     break;
  3014.     CASE(F_NUMBER);
  3015.     ((char *)&i)[0] = pc[0];
  3016.     ((char *)&i)[1] = pc[1];
  3017.     ((char *)&i)[2] = pc[2];
  3018.     ((char *)&i)[3] = pc[3];
  3019.     pc += 4;
  3020.     push_number(i);
  3021.     break;
  3022.     CASE(F_ASSIGN);
  3023. #ifdef DEBUG
  3024.     if (sp[-1].type != T_LVALUE)
  3025.         fatal("Bad argument to F_ASSIGN\n");
  3026. #endif
  3027.     assign_svalue((sp-1)->u.lvalue, sp);
  3028.     assign_svalue(sp-1, sp);
  3029.     pop_stack();
  3030.     break;
  3031.     CASE(F_CTIME);
  3032.     {
  3033.     char *cp;
  3034.     cp = string_copy(time_string(sp->u.number));
  3035.     pop_stack();
  3036.     push_malloced_string(cp);
  3037.     /* Now strip the newline. */
  3038.     cp = strchr(cp, '\n');
  3039.     if (cp)
  3040.         *cp = '\0';
  3041.     break;
  3042.     }
  3043.     CASE(F_ADD_EQ);
  3044.     if (sp[-1].type != T_LVALUE)
  3045.         bad_arg(1, F_ADD_EQ);
  3046.     argp = sp[-1].u.lvalue;
  3047.     switch(argp->type) {
  3048.     case T_STRING:
  3049.     {
  3050.         char *new_str;
  3051.         if (sp->type == T_STRING) {
  3052.         int l = strlen(argp->u.string);
  3053.         new_str = xalloc(l + strlen(sp->u.string) + 1);
  3054.         strcpy(new_str, argp->u.string);
  3055.         strcpy(new_str+l, sp->u.string);
  3056.         pop_n_elems(2);
  3057.         push_malloced_string(new_str);
  3058.         } else if (sp->type == T_NUMBER) {
  3059.         char buff[20];
  3060.         sprintf(buff, "%d", sp->u.number);
  3061.         new_str = xalloc(strlen(argp->u.string) + strlen(buff) + 1);
  3062.         strcpy(new_str, argp->u.string);
  3063.         strcat(new_str, buff);
  3064.         pop_n_elems(2);
  3065.         push_malloced_string(new_str);
  3066.         } else {
  3067.         bad_arg(2, F_ADD_EQ);
  3068.         }
  3069.         break;
  3070.     }
  3071.     case T_NUMBER:
  3072.         if (sp->type == T_NUMBER) {
  3073.             i = argp->u.number + sp->u.number;
  3074.         pop_n_elems(2);
  3075.         push_number(i);
  3076.         } else {
  3077.             error("Bad type number to rhs +=.\n");
  3078.         }
  3079.         break;
  3080.         case T_POINTER:
  3081.         if (sp->type != T_POINTER) {
  3082.         error("Bad type to rhs +=.\n");
  3083.         } else {
  3084.           struct vector *v;
  3085.           check_for_destr(argp->u.vec);
  3086.           check_for_destr(sp->u.vec);
  3087.           v = add_array(argp->u.vec,sp->u.vec);
  3088.           pop_n_elems(2);
  3089.           push_vector(v); /* This will make ref count == 2 */
  3090.           v->ref--;
  3091.         }
  3092.         break;          
  3093.     default:
  3094.         error("Bad type to lhs +=");
  3095.     }
  3096.     assign_svalue(argp, sp);
  3097.     break;
  3098.     CASE(F_SUB_EQ);
  3099.     if (sp[-1].type != T_LVALUE)
  3100.         bad_arg(1, F_SUB_EQ);
  3101.     argp = sp[-1].u.lvalue;
  3102.     switch (argp->type) {
  3103.     case T_NUMBER:
  3104.     if (sp->type != T_NUMBER)
  3105.             error("Bad right type to -=");
  3106.         argp->u.number -= sp->u.number;
  3107.         sp--;
  3108.             break;
  3109.     case T_POINTER:
  3110.       {
  3111.         struct vector *subtract_array PROT((struct vector*,struct vector*));
  3112.         struct vector *v;
  3113.  
  3114.         if (sp->type != T_POINTER)
  3115.             error("Bad right type to -=");
  3116.         v = sp->u.vec;
  3117.         if (v->ref > 1) {
  3118.         v = slice_array(v, 0, v->size-1 );
  3119.         v->ref--;
  3120.             }
  3121.         sp--;
  3122.         v = subtract_array(argp->u.vec, v);
  3123.         free_vector(argp->u.vec);
  3124.         argp->u.vec = v;
  3125.         break;
  3126.       }
  3127.     default:
  3128.         error("Bad left type to -=.\n");
  3129.     }
  3130.     assign_svalue_no_free(sp, argp);
  3131.     break;
  3132.     CASE(F_MULT_EQ);
  3133.     if (sp[-1].type != T_LVALUE)
  3134.         bad_arg(1, F_MULT_EQ);
  3135.     argp = sp[-1].u.lvalue;
  3136.     if (argp->type != T_NUMBER)
  3137.         error("Bad left type to *=.\n");
  3138.     if (sp->type != T_NUMBER)
  3139.         error("Bad right type to *=");
  3140.     i = argp->u.number * sp->u.number;
  3141.     pop_n_elems(2);
  3142.     push_number(i);
  3143.     assign_svalue(argp, sp);
  3144.     break;
  3145.     CASE(F_AND_EQ);
  3146.     if (sp[-1].type != T_LVALUE)
  3147.         bad_arg(1, F_AND_EQ);
  3148.     argp = sp[-1].u.lvalue;
  3149.     if (argp->type != T_NUMBER)
  3150.         error("Bad left type to &=.\n");
  3151.     if (sp->type != T_NUMBER)
  3152.         error("Bad right type to &=");
  3153.     i = argp->u.number & sp->u.number;
  3154.     pop_n_elems(2);
  3155.     push_number(i);
  3156.     assign_svalue(argp, sp);
  3157.     break;
  3158.     CASE(F_OR_EQ);
  3159.     if (sp[-1].type != T_LVALUE)
  3160.         bad_arg(1, F_OR_EQ);
  3161.     argp = sp[-1].u.lvalue;
  3162.     if (sp[-1].type != T_LVALUE)
  3163.         bad_arg(1, F_OR_EQ);
  3164.     argp = sp[-1].u.lvalue;
  3165.     if (argp->type != T_NUMBER)
  3166.         error("Bad left type to |=.\n");
  3167.     if (sp->type != T_NUMBER)
  3168.         error("Bad right type to |=");
  3169.     i = argp->u.number | sp->u.number;
  3170.     pop_n_elems(2);
  3171.     push_number(i);
  3172.     assign_svalue(argp, sp);
  3173.     break;
  3174.     CASE(F_XOR_EQ);
  3175.     if (sp[-1].type != T_LVALUE)
  3176.         bad_arg(1, F_XOR_EQ);
  3177.     argp = sp[-1].u.lvalue;
  3178.     if (argp->type != T_NUMBER)
  3179.         error("Bad left type to ^=.\n");
  3180.     if (sp->type != T_NUMBER)
  3181.         error("Bad right type to ^=");
  3182.     i = argp->u.number ^ sp->u.number;
  3183.     pop_n_elems(2);
  3184.     push_number(i);
  3185.     assign_svalue(argp, sp);
  3186.     break;
  3187.     CASE(F_LSH_EQ);
  3188.     if (sp[-1].type != T_LVALUE)
  3189.         bad_arg(1, F_LSH_EQ);
  3190.     argp = sp[-1].u.lvalue;
  3191.     if (argp->type != T_NUMBER)
  3192.         error("Bad left type to <<=.\n");
  3193.     if (sp->type != T_NUMBER)
  3194.         error("Bad right type to <<=");
  3195.     i = argp->u.number << sp->u.number;
  3196.     pop_n_elems(2);
  3197.     push_number(i);
  3198.     assign_svalue(argp, sp);
  3199.     break;
  3200.     CASE(F_RSH_EQ);
  3201.     if (sp[-1].type != T_LVALUE)
  3202.         bad_arg(1, F_RSH_EQ);
  3203.     argp = sp[-1].u.lvalue;
  3204.     if (argp->type != T_NUMBER)
  3205.         error("Bad left type to >>=.\n");
  3206.     if (sp->type != T_NUMBER)
  3207.         error("Bad right type to >>=");
  3208.     i = argp->u.number >> sp->u.number;
  3209.     pop_n_elems(2);
  3210.     push_number(i);
  3211.     assign_svalue(argp, sp);
  3212.     break;
  3213. #ifdef F_COMBINE_FREE_LIST
  3214.     CASE(F_COMBINE_FREE_LIST);
  3215. #ifdef MALLOC_malloc
  3216.     push_number(resort_free_list());
  3217. #else
  3218.     push_number(0);
  3219. #endif
  3220.     break;
  3221. #endif
  3222.     CASE(F_DIV_EQ);
  3223.     if (sp[-1].type != T_LVALUE)
  3224.         bad_arg(1, F_DIV_EQ);
  3225.     argp = sp[-1].u.lvalue;
  3226.     if (argp->type != T_NUMBER)
  3227.         error("Bad left type to /=.\n");
  3228.     if (sp->type != T_NUMBER)
  3229.         error("Bad right type to /=");
  3230.     if (sp->u.number == 0)
  3231.         error("Division by 0\n");
  3232.     i = argp->u.number / sp->u.number;
  3233.     pop_n_elems(2);
  3234.     push_number(i);
  3235.     assign_svalue(argp, sp);
  3236.     break;
  3237.     CASE(F_MOD_EQ);
  3238.     if (sp[-1].type != T_LVALUE)
  3239.         bad_arg(1, F_MOD_EQ);
  3240.     argp = sp[-1].u.lvalue;
  3241.     if (argp->type != T_NUMBER)
  3242.         error("Bad left type to %=.\n");
  3243.     if (sp->type != T_NUMBER)
  3244.         error("Bad right type to %=");
  3245.     if (sp->u.number == 0)
  3246.         error("Division by 0\n");
  3247.     i = argp->u.number % sp->u.number;
  3248.     pop_n_elems(2);
  3249.     push_number(i);
  3250.     assign_svalue(argp, sp);
  3251.     break;
  3252.     CASE(F_STRING);
  3253.     {
  3254.     unsigned short string_number;
  3255.     ((char *)&string_number)[0] = pc[0];
  3256.     ((char *)&string_number)[1] = pc[1];
  3257.     pc += 2;
  3258.     push_string(current_prog->strings[string_number],
  3259.             STRING_CONSTANT);
  3260.     break;
  3261.     }
  3262. #ifdef F_RUSAGE
  3263.     CASE(F_RUSAGE);
  3264.     {
  3265.         char buff[500];
  3266.  
  3267.     struct rusage rus;
  3268.     long utime, stime;
  3269.     int maxrss;
  3270.  
  3271.     if (getrusage(RUSAGE_SELF, &rus) < 0)
  3272.             buff[0] = 0;
  3273.     else {
  3274.         utime = rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
  3275.         stime = rus.ru_stime.tv_sec * 1000 + rus.ru_stime.tv_usec / 1000;
  3276.         maxrss = rus.ru_maxrss;
  3277. #ifdef sun
  3278.         maxrss *= getpagesize() / 1024;
  3279. #endif
  3280.         sprintf(buff, "%ld %ld %d %d %d %d %d %d %d %d %d %d %d %d %d %d",
  3281.             utime, stime, maxrss, rus.ru_ixrss, rus.ru_idrss,
  3282.             rus.ru_isrss, rus.ru_minflt, rus.ru_majflt, rus.ru_nswap,
  3283.             rus.ru_inblock, rus.ru_oublock, rus.ru_msgsnd, 
  3284.             rus.ru_msgrcv, rus.ru_nsignals, rus.ru_nvcsw, 
  3285.             rus.ru_nivcsw);
  3286.       }
  3287.     push_string(buff, STRING_MALLOC);
  3288.     break;
  3289.     }
  3290. #endif
  3291.     CASE(F_CINDENT);
  3292.     {
  3293.     char *path;
  3294.  
  3295. #ifdef COMPAT_MODE
  3296.     path = check_file_name(sp->u.string, 1);
  3297. #else
  3298.     path = check_valid_path(sp->u.string, current_object->eff_user, "cindent", 1);
  3299. #endif
  3300.     if (path) {
  3301.         if (indent_program(path)) {
  3302.         assign_svalue(sp, &const1);
  3303.         break;
  3304.         }
  3305.     } else {
  3306.         add_message("Illegal attempt to indent\n");
  3307.     }
  3308.     assign_svalue(sp, &const0);
  3309.     break;
  3310.     }
  3311.     CASE(F_DESCRIBE);
  3312.     {
  3313.     char *str;
  3314.     int live;
  3315.  
  3316.     if (num_arg < 3) live = 0;
  3317.     else {
  3318.         if (sp->type != T_NUMBER) bad_arg (3, F_DESCRIBE);
  3319.         live = sp->u.number;
  3320.         pop_stack ();
  3321.     }
  3322.     str = describe_items(sp-1, sp->u.string, live);
  3323.     pop_n_elems(2);
  3324.     if (str) push_malloced_string (string_copy (str));
  3325.     else     push_number(0);
  3326.     break;
  3327.     }
  3328.     CASE(F_UNIQUE_ARRAY); {
  3329.     extern struct vector
  3330.         *make_unique PROT((struct vector *arr,char *func,
  3331.         struct svalue *skipnum));
  3332.     struct vector *res;
  3333.  
  3334.     if (num_arg < 3) {
  3335.         check_for_destr((sp-1)->u.vec);
  3336.         res = make_unique((sp-1)->u.vec, sp->u.string, &const0);
  3337.     } else {
  3338.         check_for_destr((sp-2)->u.vec);
  3339.         res = make_unique((sp-2)->u.vec, (sp-1)->u.string, sp);
  3340.         pop_stack ();
  3341.     }
  3342.     pop_n_elems(2);
  3343.     if (res) {
  3344.         push_vector (res);    /* This will make ref count == 2 */
  3345.         res->ref--;
  3346.     } else
  3347.         push_number (0);
  3348.     break;
  3349.     }
  3350.     CASE(F_VERSION); {
  3351.     char buff[9];
  3352.     sprintf(buff, "%6.6s%02d", GAME_VERSION, PATCH_LEVEL);
  3353.         push_string(buff, STRING_MALLOC);
  3354.         break;
  3355.     }
  3356. #ifdef F_RENAME
  3357.     CASE(F_RENAME); {
  3358.     i = do_rename((sp-1)->u.string, sp->u.string);
  3359.     pop_n_elems(2);
  3360.     push_number(i);
  3361.     break;
  3362.     }
  3363. #endif /* F_RENAME */
  3364.     CASE(F_MAP_ARRAY); {
  3365.     struct vector *res;
  3366.     struct svalue *arg;
  3367.  
  3368.     arg = sp - num_arg + 1; ob = 0;
  3369.  
  3370.     if (arg[2].type == T_OBJECT)
  3371.         ob = arg[2].u.ob;
  3372.     else if (arg[2].type == T_STRING) 
  3373.         ob = find_object(arg[2].u.string);
  3374.  
  3375.     if (!ob)
  3376.         bad_arg (3, F_MAP_ARRAY);
  3377.  
  3378.     if (arg[0].type == T_POINTER) {
  3379.         check_for_destr(arg[0].u.vec);
  3380.         res = map_array (arg[0].u.vec, arg[1].u.string, ob,
  3381.                  num_arg > 3 ? sp : (struct svalue *)0);
  3382.     } else {
  3383.         res = 0;
  3384.     }
  3385.     pop_n_elems (num_arg);
  3386.     if (res) {
  3387.         push_vector (res);    /* This will make ref count == 2 */
  3388.         res->ref--;
  3389.     } else
  3390.         push_number (0);
  3391.     break;
  3392.     }
  3393.     CASE(F_SORT_ARRAY); {
  3394.     extern struct vector *sort_array
  3395.       PROT((struct vector*,char *,struct object *));
  3396.     struct vector *res;
  3397.     struct svalue *arg;
  3398.  
  3399.     arg = sp - 2; ob = 0;
  3400.  
  3401.     if (arg[2].type == T_OBJECT)
  3402.         ob = arg[2].u.ob;
  3403.     else if (arg[2].type == T_STRING) 
  3404.         ob = find_object(arg[2].u.string);
  3405.  
  3406.     if (!ob)
  3407.         bad_arg (3, F_SORT_ARRAY);
  3408.  
  3409.     if (arg[0].type == T_POINTER) {
  3410.         /* sort_array already takes care of destructed objects */
  3411.         res = sort_array (
  3412.           slice_array(arg[0].u.vec, 0, arg[0].u.vec->size-1),
  3413.           arg[1].u.string, ob);
  3414.     } else
  3415.         res = 0;
  3416.     pop_n_elems (3);
  3417.     sp++;
  3418.     if (res) {
  3419.         sp->type = T_POINTER;
  3420.         sp->u.vec = res;
  3421.     }
  3422.     else     *sp = const0;
  3423.     break;
  3424.     }
  3425. #ifdef F_ORDER_ALIST
  3426.     CASE(F_ORDER_ALIST);
  3427.     {
  3428.     extern struct vector *order_alist PROT((struct vector *));
  3429.     struct svalue *args;
  3430.     struct vector *list;
  3431.     int listsize,keynum;
  3432.  
  3433.     if (num_arg == 1 && sp->u.vec->size 
  3434.           && sp->u.vec->item[0].type == T_POINTER) {
  3435.             args     = sp->u.vec->item;
  3436.         listsize = sp->u.vec->size;
  3437.     } else {
  3438.         args = sp-num_arg+1;
  3439.         listsize = num_arg;
  3440.     }
  3441.     keynum = args[0].u.vec->size;
  3442.     list = allocate_array(listsize);
  3443.     for (i=0; i<listsize; i++) {
  3444.         if (args[i].type != T_POINTER
  3445.          || args[i].u.vec->size != keynum) {
  3446.         free_vector(list);
  3447.         error("bad data array %d in call to order_alist",i);
  3448.         }
  3449.         list->item[i].type = T_POINTER;
  3450.         list->item[i].u.vec = slice_array(args[i].u.vec,0,keynum-1);
  3451.         }
  3452.         pop_n_elems(num_arg);
  3453.     sp++;
  3454.     sp->type = T_POINTER;
  3455.         sp->u.vec = order_alist(list);
  3456.     free_vector(list);
  3457.         break;
  3458.     }
  3459. #endif /* F_ORDER_ALIST */
  3460. #ifdef F_INSERT_ALIST
  3461.     CASE(F_INSERT_ALIST)
  3462.     {
  3463.     /* When the key list of an alist contains destructed objects
  3464.        it is better not to free them till the next reordering by
  3465.        order_alist to retain the alist property.
  3466.      */
  3467.     extern struct svalue *insert_alist
  3468.       PROT((struct svalue *key,struct svalue *key_data,
  3469.         struct vector *list));
  3470.     struct vector *list;
  3471.     int listsize,keynum;
  3472.     struct svalue *key,*key_data,*ret;
  3473.     static struct vector tempvec = { 1,1, };
  3474.  
  3475.     if (sp->type != T_POINTER)
  3476.         bad_arg(num_arg,F_INSERT_ALIST);
  3477.     if ( !(listsize = sp->u.vec->size) ||
  3478.       sp->u.vec->item[0].type != T_POINTER ) {
  3479.         list = &tempvec;
  3480.         assign_svalue_no_free(list->item,sp);
  3481.         listsize = 1;
  3482.     } else
  3483.         list = sp->u.vec;
  3484.     keynum = list->item[0].u.vec->size;
  3485.     for (i=1; i<listsize; i++) {
  3486.         if (list->item[i].type != T_POINTER
  3487.           ||list->item[i].u.vec->size != keynum)
  3488.         bad_arg(num_arg,F_INSERT_ALIST);
  3489.     }
  3490.     if (num_arg == 2) {
  3491.         if (sp[-1].type != T_POINTER) {
  3492.         key_data = (struct svalue*)NULL;
  3493.         key = sp-1;
  3494.         } else {
  3495.             if (sp[-1].u.vec->size != listsize)
  3496.             bad_arg(1,F_INSERT_ALIST);
  3497.             key_data = key = sp[-1].u.vec->item;
  3498.         }
  3499.     } else {
  3500.         if (num_arg - 1 != listsize)
  3501.         bad_arg(1,F_INSERT_ALIST);
  3502.             key_data = key = sp-num_arg+1;
  3503.     }
  3504.     ret = insert_alist(key,key_data,list);
  3505.     pop_n_elems(num_arg);
  3506.     sp++;
  3507.     *sp = *ret;
  3508.     break;
  3509.     }
  3510. #endif /* F_INSERT_ALIST */
  3511. #ifdef F_ASSOC
  3512.     CASE(F_ASSOC);
  3513.     {
  3514.     /* When the key list of an alist contains destructed objects
  3515.        it is better not to free them till the next reordering by
  3516.        order_alist to retain the alist property.
  3517.      */
  3518.     int assoc PROT((struct svalue *key, struct vector *keys));
  3519.     struct svalue *args = sp -num_arg +1;
  3520.     struct vector *keys,*data;
  3521.     struct svalue *fail_val;
  3522.     int ix;
  3523.  
  3524.     if ( !args[1].u.vec->size ||
  3525.       args[1].u.vec->item[0].type != T_POINTER ) {
  3526.         keys = args[1].u.vec;
  3527.         if (num_arg == 2) {
  3528.         data = (struct vector *)NULL;
  3529.         } else {
  3530.         if (args[2].type != T_POINTER ||
  3531.           args[2].u.vec->size != keys->size) {
  3532.             bad_arg(3,F_ASSOC);
  3533.         }
  3534.         data = args[2].u.vec;
  3535.         }
  3536.         if (num_arg == 4) {
  3537.         fail_val = &args[3];
  3538.         } else {
  3539.         fail_val = &const0;
  3540.         }
  3541.     } else {
  3542.         keys = args[1].u.vec->item[0].u.vec;
  3543.         if (args[1].u.vec->size > 1) {
  3544.         if (args[1].u.vec->item[1].type != T_POINTER ||
  3545.             args[1].u.vec->item[1].u.vec->size != keys->size) {
  3546.             bad_arg(2,F_ASSOC);
  3547.             }
  3548.         data = args[1].u.vec->item[1].u.vec;
  3549.         } else {
  3550.         data = (struct vector *)NULL;
  3551.         }
  3552.         if (num_arg == 3) fail_val = &args[2];
  3553.         else if (num_arg == 2) fail_val = &const0;
  3554.         else {
  3555.         error ("too many args to efun assoc");
  3556.         }
  3557.     }
  3558.     ix = assoc(&args[0],keys);
  3559.     if (data == (struct vector *)NULL) {
  3560.         pop_n_elems(num_arg);
  3561.         push_number(ix);
  3562.     } else {
  3563.         assign_svalue(args, ix==-1 ? fail_val : &data->item[ix]);
  3564.         pop_n_elems(num_arg-1);
  3565.     }
  3566.         break;
  3567.     }
  3568. #endif /* F_ASSOC */
  3569. #ifdef F_INTERSECT_ALIST
  3570.     CASE(F_INTERSECT_ALIST);
  3571.     {
  3572.     extern struct vector *intersect_alist
  3573.       PROT((struct vector *, struct vector *));
  3574.     struct vector *tmp = intersect_alist( (sp-1)->u.vec, sp->u.vec );
  3575.     pop_stack();
  3576.     free_vector(sp->u.vec);
  3577.     sp->u.vec = tmp;
  3578.     }
  3579. #endif /* F_INTERSECT_ALIST */
  3580. #ifdef F_DEBUG_INFO
  3581.     CASE(F_DEBUG_INFO);
  3582.     {
  3583.     struct svalue *arg = sp-num_arg+1;
  3584.     struct svalue res;
  3585.  
  3586.     switch ( arg[0].u.number ) {
  3587.         case 0:
  3588.         {
  3589.         int flags;
  3590.         struct object *obj2;
  3591.  
  3592.         if (num_arg != 2)
  3593.                 error("bad number of arguments to debug_info");
  3594.         if ( arg[1].type != T_OBJECT)
  3595.             bad_arg(1,instruction);
  3596.         ob = arg[1].u.ob;
  3597.         flags = ob->flags;
  3598.         add_message("O_HEART_BEAT      : %s\n",
  3599.           flags&O_HEART_BEAT      ?"TRUE":"FALSE");
  3600.         add_message("O_IS_WIZARD       : %s\n",
  3601.           flags&O_IS_WIZARD       ?"TRUE":"FALSE");
  3602.         add_message("O_ENABLE_COMMANDS : %s\n",
  3603.           flags&O_ENABLE_COMMANDS ?"TRUE":"FALSE");
  3604.         add_message("O_CLONE           : %s\n",
  3605.           flags&O_CLONE           ?"TRUE":"FALSE");
  3606.         add_message("O_DESTRUCTED      : %s\n",
  3607.           flags&O_DESTRUCTED      ?"TRUE":"FALSE");
  3608.         add_message("O_SWAPPED         : %s\n",
  3609.           flags&O_SWAPPED          ?"TRUE":"FALSE");
  3610.         add_message("O_ONCE_INTERACTIVE: %s\n",
  3611.           flags&O_ONCE_INTERACTIVE?"TRUE":"FALSE");
  3612.         add_message("O_APPROVED        : %s\n",
  3613.           flags&O_APPROVED        ?"TRUE":"FALSE");
  3614.         add_message("O_RESET_STATE     : %s\n",
  3615.           flags&O_RESET_STATE     ?"TRUE":"FALSE");
  3616.         add_message("O_WILL_CLEAN_UP   : %s\n",
  3617.           flags&O_WILL_CLEAN_UP   ?"TRUE":"FALSE");
  3618.             add_message("total light : %d\n", ob->total_light);
  3619.         add_message("next_reset  : %d\n", ob->next_reset);
  3620.         add_message("time_of_ref : %d\n", ob->time_of_ref);
  3621.         add_message("ref         : %d\n", ob->ref);
  3622. #ifdef DEBUG
  3623.         add_message("extra_ref   : %d\n", ob->extra_ref);
  3624. #endif
  3625.         add_message("swap_num    : %ld\n", ob->swap_num);
  3626.         add_message("name        : '%s'\n", ob->name);
  3627.         add_message("next_all    : OBJ(%s)\n",
  3628.           ob->next_all?ob->next_all->name:"NULL");
  3629.         if (obj_list == ob) add_message(
  3630.             "This object is the head of the object list.\n");
  3631.         for (obj2=obj_list,i=1; obj2; obj2=obj2->next_all,i++)
  3632.             if (obj2->next_all == ob) {
  3633.             add_message(
  3634.                 "Previous object in object list: OBJ(%s)\n",
  3635.                 obj2->name);
  3636.             add_message("position in object list:%d\n",i);
  3637.             }
  3638.         assign_svalue_no_free(&res,&const0);
  3639.         break;
  3640.         }
  3641.         case 1: {
  3642.         if (num_arg != 2)
  3643.                 error("bad number of arguments to debug_info");
  3644.         if ( arg[1].type != T_OBJECT)
  3645.             bad_arg(1,instruction);
  3646.         ob = arg[1].u.ob;
  3647.         
  3648.         add_message("program ref's %d\n", ob->prog->ref);
  3649.         add_message("Name %s\n", ob->prog->name);
  3650.         add_message("program size %d\n",
  3651.         ob->prog->program_size);
  3652.         add_message("num func's %d (%d) \n", ob->prog->num_functions
  3653.         ,ob->prog->num_functions * sizeof(struct function));
  3654.         add_message("num strings %d\n", ob->prog->num_strings);
  3655.         add_message("num vars %d (%d)\n", ob->prog->num_variables
  3656.         ,ob->prog->num_variables * sizeof(struct variable));
  3657.         add_message("num inherits %d (%d)\n", ob->prog->num_inherited
  3658.         ,ob->prog->num_inherited * sizeof(struct inherit));
  3659.         add_message("total size %d\n", ob->prog->total_size);
  3660.         assign_svalue_no_free(&res,&const0);
  3661.         break;
  3662.         }
  3663.         default: bad_arg(1,instruction);
  3664.     }
  3665.     pop_n_elems(num_arg);
  3666.     sp++;
  3667.     *sp=res;
  3668.     break;
  3669.     }
  3670. #endif /* F_DEBUG_INFO */
  3671.     }
  3672. #ifdef DEBUG
  3673.     if (expected_stack && expected_stack != sp ||
  3674.     sp < fp + csp->num_local_variables - 1)
  3675.     {
  3676.     fatal("Bad stack after evaluation. Instruction %d, num arg %d\n",
  3677.           instruction, num_arg);
  3678.     }
  3679. #endif /* DEBUG */
  3680.     goto again;
  3681. }
  3682.  
  3683. /*
  3684.  * Apply a fun 'fun' to the program in object 'ob', with
  3685.  * 'num_arg' arguments (already pushed on the stack).
  3686.  * If the function is not found, search in the object pointed to by the
  3687.  * inherit pointer.
  3688.  * If the function name starts with '::', search in the object pointed out
  3689.  * through the inherit pointer by the current object. The 'current_object'
  3690.  * stores the base object, not the object that has the current function being
  3691.  * evaluated. Thus, the variable current_prog will normally be the same as
  3692.  * current_object->prog, but not when executing inherited code. Then,
  3693.  * it will point to the code of the inherited object. As more than one
  3694.  * object can be inherited, the call of function by index number has to
  3695.  * be adjusted. The function number 0 in a superclass object must not remain
  3696.  * number 0 when it is inherited from a subclass object. The same problem
  3697.  * exists for variables. The global variables function_index_offset and
  3698.  * variable_index_offset keep track of how much to adjust the index when
  3699.  * executing code in the superclass objects.
  3700.  *
  3701.  * There is a special case when called from the heart beat, as
  3702.  * current_prog will be 0. When it is 0, set current_prog
  3703.  * to the 'ob->prog' sent as argument.
  3704.  *
  3705.  * Arguments are always removed from the stack.
  3706.  * If the function is not found, return 0 and nothing on the stack.
  3707.  * Otherwise, return 1, and a pushed return value on the stack.
  3708.  *
  3709.  * Note that the object 'ob' can be destructed. This must be handled by
  3710.  * the caller of apply().
  3711.  *
  3712.  * If the function failed to be called, then arguments must be deallocated
  3713.  * manually !
  3714.  */
  3715.  
  3716. char debug_apply_fun[30]; /* For debugging */
  3717.  
  3718. static int apply_low(fun, ob, num_arg)
  3719.     char *fun;
  3720.     struct object *ob;
  3721.     int num_arg;
  3722. {
  3723.     static int cache_id[0x40] = {
  3724.       0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  3725.       0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 };
  3726.     static char *cache_name[0x40];
  3727.     static struct function *cache_pr[0x40];
  3728.     static struct function *cache_pr_inherited[0x40];
  3729.     static struct program *cache_progp[0x40];
  3730.     static int cache_function_index_offset[0x40];
  3731.     static int cache_variable_index_offset[0x40];
  3732.  
  3733.     struct function *pr;
  3734.     struct program *progp;
  3735.     extern int num_error;
  3736.     struct control_stack *save_csp;
  3737.     int ix;
  3738.  
  3739.     ob->time_of_ref = current_time;    /* Used by the swapper */
  3740.     /*
  3741.      * This object will now be used, and is thus a target for
  3742.      * reset later on (when time due).
  3743.      */
  3744.     ob->flags &= ~O_RESET_STATE;
  3745. #ifdef DEBUG
  3746.     strncpy(debug_apply_fun, fun, sizeof debug_apply_fun);
  3747.     debug_apply_fun[sizeof debug_apply_fun - 1] = '\0';
  3748. #endif
  3749.     if (num_error > 0)
  3750.     goto failure;
  3751.     if (fun[0] == ':')
  3752.     error("Illegal function call\n");
  3753.     /*
  3754.      * If there is a chain of objects shadowing, start with the first
  3755.      * of these.
  3756.      */
  3757.     while (ob->shadowed && ob->shadowed != current_object)
  3758.     ob = ob->shadowed;
  3759. retry_for_shadow:
  3760.     if (ob->flags & O_SWAPPED)
  3761.     load_ob_from_swap(ob);
  3762.     progp = ob->prog;
  3763. #ifdef DEBUG
  3764.     if (ob->flags & O_DESTRUCTED)
  3765.     fatal("apply() on destructed object\n");
  3766. #endif
  3767.     ix = ( progp->id_number ^ (int)fun ^ ( (int)fun >> 6 ) ) & 0x3f;
  3768.     if (cache_id[ix] == progp->id_number && !strcmp(cache_name[ix], fun) &&
  3769.     (!cache_progp[ix] || cache_progp[ix] == ob->prog)) {
  3770.         /* We have found a matching entry in the cache. The pointer to
  3771.        the function name has to match, not only the contents.
  3772.        This is because hashing the string in order to get a cache index
  3773.        would be much more costly than hashing it's pointer.
  3774.        If cache access would be costly, the cache would be useless.
  3775.        */
  3776.     if (cache_progp[ix]) {
  3777.         /* the cache will tell us in wich program the function is, and
  3778.          * where
  3779.          */
  3780.         push_control_stack(cache_pr[ix]);
  3781.         csp->num_local_variables = num_arg;
  3782.         current_prog = cache_progp[ix];
  3783.         pr = cache_pr_inherited[ix];
  3784.         function_index_offset = cache_function_index_offset[ix];
  3785.         variable_index_offset = cache_variable_index_offset[ix];
  3786.         /* Remove excessive arguments */
  3787.         while(csp->num_local_variables > pr->num_arg) {
  3788.         pop_stack();
  3789.         csp->num_local_variables--;
  3790.         }
  3791.         /* Correct number of arguments and local variables */
  3792.         while(csp->num_local_variables < pr->num_arg + pr->num_local) {
  3793.         push_number(0);
  3794.         csp->num_local_variables++;
  3795.         }
  3796.         tracedepth++;
  3797.         if (TRACEP(TRACE_CALL)) {
  3798.         do_trace_call(pr);
  3799.         }
  3800.         fp = sp - csp->num_local_variables + 1;
  3801.         break_sp = (short*)(sp+1);
  3802. #ifdef OLD_PREVIOUS_OBJECT_BEHAVIOUR
  3803.         /* Now, previous_object() is always set, even by
  3804.          * call_other(this_object()). It should not break any
  3805.          * compatibility.
  3806.          */
  3807.         if (current_object != ob)
  3808. #endif
  3809.         previous_ob = current_object;
  3810.         current_object = ob;
  3811.         save_csp = csp;
  3812.         eval_instruction(current_prog->program + pr->offset);
  3813. #ifdef DEBUG
  3814.         if (save_csp-1 != csp)
  3815.         fatal("Bad csp after execution in apply_low\n");
  3816. #endif
  3817.         /*
  3818.          * Arguments and local variables are now removed. One
  3819.          * resulting value is always returned on the stack.
  3820.          */
  3821.         return 1;
  3822.     } /* when we come here, the cache has told us that the function isn't
  3823.        * defined in the object
  3824.        */
  3825.     } else {
  3826.     /* we have to search the function */
  3827.     if (!cache_progp[ix] && cache_id[ix]) {
  3828.         /* The old cache entry was for an undefined function, so the
  3829.            name had to be malloced */
  3830.         free(cache_name[ix]);
  3831.     }
  3832.     cache_id[ix] = progp->id_number;
  3833.         for(pr=progp->functions; pr < progp->functions + progp->num_functions;
  3834.             pr++)
  3835.         {
  3836.             eval_cost++;
  3837.             if (pr->name == 0 ||
  3838.                 pr->name[0] != fun[0] ||
  3839.                 strcmp(pr->name, fun) != 0 ||
  3840.                 (pr->type & TYPE_MOD_PRIVATE))
  3841.             {
  3842.                 continue;
  3843.             }
  3844.             if (pr->flags & NAME_UNDEFINED)
  3845.                 continue;
  3846.             /* Static functions may not be called from outside. */
  3847.             if ((pr->type & (TYPE_MOD_STATIC|TYPE_MOD_PRIVATE)) &&
  3848.         current_object != ob)
  3849.         {
  3850.                 continue;
  3851.         }
  3852.         /* The searched function is found */
  3853.         cache_pr[ix] = pr;
  3854.         cache_name[ix] = pr->name;
  3855.         push_control_stack(pr);
  3856.         csp->num_local_variables = num_arg;
  3857.         current_prog = progp;
  3858.         pr = setup_new_frame(pr);
  3859.         cache_pr_inherited[ix] = pr;
  3860.         cache_progp[ix] = current_prog;
  3861.         cache_variable_index_offset[ix] = variable_index_offset;
  3862.         cache_function_index_offset[ix] = function_index_offset;
  3863. #ifdef OLD_PREVIOUS_OBJECT_BEHAVIOUR
  3864.             if (current_object != ob)
  3865. #endif
  3866.                 previous_ob = current_object;
  3867.             current_object = ob;
  3868.             save_csp = csp;
  3869.             eval_instruction(current_prog->program + pr->offset);
  3870. #ifdef DEBUG
  3871.             if (save_csp-1 != csp)
  3872.                 fatal("Bad csp after execution in apply_low\n");
  3873. #endif
  3874.             /*
  3875.              * Arguments and local variables are now removed. One
  3876.              * resulting value is always returned on the stack.
  3877.              */
  3878.             return 1;
  3879.     }
  3880.     /* We have to mark a function not to be in the object */
  3881.     cache_name[ix] = string_copy(fun);
  3882.     cache_progp[ix] = (struct program *)0;
  3883.     }
  3884.     if (ob->shadowing) {
  3885.     /*
  3886.      * This is an object shadowing another. The function was not found,
  3887.      * but can maybe be found in the object we are shadowing.
  3888.      */
  3889.     ob = ob->shadowing;
  3890.     goto retry_for_shadow;
  3891.     }
  3892. failure:
  3893.     /* Failure. Deallocate stack. */
  3894.     pop_n_elems(num_arg);
  3895.     return 0;
  3896. }
  3897.  
  3898. /*
  3899.  * Arguments are supposed to be
  3900.  * pushed (using push_string() etc) before the call. A pointer to a
  3901.  * 'struct svalue' will be returned. It will be a null pointer if the called
  3902.  * function was not found. Otherwise, it will be a pointer to a static
  3903.  * area in apply(), which will be overwritten by the next call to apply.
  3904.  * Reference counts will be updated for this value, to ensure that no pointers
  3905.  * are deallocated.
  3906.  */
  3907.  
  3908. static struct svalue *sapply(fun, ob, num_arg)
  3909.     char *fun;
  3910.     struct object *ob;
  3911.     int num_arg;
  3912. {
  3913. #ifdef DEBUG
  3914.     struct svalue *expected_sp;
  3915. #endif
  3916.     static struct svalue ret_value = { T_NUMBER };
  3917.  
  3918.     if (TRACEP(TRACE_APPLY)) {
  3919.     do_trace("Apply", "", "\n");
  3920.     }
  3921. #ifdef DEBUG
  3922.     expected_sp = sp - num_arg;
  3923. #endif
  3924.     if (apply_low(fun, ob, num_arg) == 0)
  3925.     return 0;
  3926.     assign_svalue(&ret_value, sp);
  3927.     pop_stack();
  3928. #ifdef DEBUG
  3929.     if (expected_sp != sp)
  3930.     fatal("Corrupt stack pointer.\n");
  3931. #endif
  3932.     return &ret_value;
  3933. }
  3934.  
  3935. struct svalue *apply(fun, ob, num_arg)
  3936.     char *fun;
  3937.     struct object *ob;
  3938.     int num_arg;
  3939. {
  3940.     tracedepth = 0;
  3941.     return sapply(fun, ob, num_arg);
  3942. }
  3943.  
  3944. /*
  3945.  * This function is similar to apply(), except that it will not
  3946.  * call the function, only return object name if the function exists,
  3947.  * or 0 otherwise.
  3948.  */
  3949. char *function_exists(fun, ob)
  3950.     char *fun;
  3951.     struct object *ob;
  3952. {
  3953.     struct function *pr;
  3954.  
  3955. #ifdef DEBUG
  3956.     if (ob->flags & O_DESTRUCTED)
  3957.     fatal("function_exists() on destructed object\n");
  3958. #endif
  3959.     if (ob->flags & O_SWAPPED)
  3960.     load_ob_from_swap(ob);
  3961.     pr = ob->prog->functions;
  3962.     for(; pr < ob->prog->functions + ob->prog->num_functions; pr++) {
  3963.     struct program *progp;
  3964.  
  3965.     if (pr->name[0] != fun[0] || strcmp(pr->name, fun) != 0)
  3966.         continue;
  3967.     /* Static functions may not be called from outside. */
  3968.     if ((pr->type & TYPE_MOD_STATIC) && current_object != ob)
  3969.         continue;
  3970.     if (pr->flags & NAME_UNDEFINED)
  3971.         return 0;
  3972.     for (progp = ob->prog; pr->flags & NAME_INHERITED;) {
  3973.         progp = progp->inherit[pr->offset].prog;
  3974.         pr = &progp->functions[pr->function_index_offset];
  3975.     }
  3976.     return progp->name;
  3977.     }
  3978.     return 0;
  3979. }
  3980.  
  3981. /*
  3982.  * Call a specific function address in an object. This is done with no
  3983.  * frame set up. It is expected that there are no arguments. Returned
  3984.  * values are removed.
  3985.  */
  3986.  
  3987. void call_function(progp, pr)
  3988.     struct program *progp;
  3989.     struct function *pr;
  3990. {
  3991.     if (pr->flags & NAME_UNDEFINED)
  3992.     return;
  3993.     push_control_stack(pr);
  3994. #ifdef DEBUG
  3995.     if (csp != control_stack)
  3996.     fatal("call_function with bad csp\n");
  3997. #endif
  3998.     csp->num_local_variables = 0;
  3999.     current_prog = progp;
  4000.     pr = setup_new_frame(pr);
  4001.     previous_ob = current_object;
  4002.     tracedepth = 0;
  4003.     eval_instruction(current_prog->program + pr->offset);
  4004.     pop_stack();    /* Throw away the returned result */
  4005. }
  4006.  
  4007. /*
  4008.  * This can be done much more efficiently, but the fix has
  4009.  * low priority.
  4010.  */
  4011. static int get_line_number(p, progp)
  4012.     char *p;
  4013.     struct program *progp;
  4014. {
  4015.     int offset;
  4016.     int i;
  4017.     if (progp == 0)
  4018.     return 0;
  4019.     offset = p - progp->program;
  4020. #ifdef DEBUG
  4021.     if (offset > progp->program_size)
  4022.     fatal("Illegal offset %d in object %s\n", offset, progp->name);
  4023. #endif
  4024.     for (i=0; offset > progp->line_numbers[i]; i++)
  4025.     ;
  4026.     return i + 1;
  4027. }
  4028.     
  4029. /*
  4030.  * Write out a trace. If there is an heart_beat(), then return the
  4031.  * object that had that heart beat.
  4032.  */
  4033. char *dump_trace(how)
  4034.     int how;
  4035. {
  4036.     struct control_stack *p;
  4037.     char *ret = 0;
  4038. #ifdef DEBUG
  4039.     int last_instructions PROT((void));
  4040. #endif
  4041.  
  4042.     if (current_prog == 0)
  4043.     return 0;
  4044.     if (csp < &control_stack[0]) {
  4045.     (void)printf("No trace.\n");
  4046.     debug_message("No trace.\n");
  4047.     return 0;
  4048.     }
  4049. #ifdef DEBUG
  4050. #ifdef TRACE_CODE
  4051.     if (how)
  4052.     (void)last_instructions();
  4053. #endif
  4054. #endif
  4055.     for (p = &control_stack[0]; p < csp; p++) {
  4056.     (void)printf("'%15s' in '%20s' ('%20s')line %d\n",
  4057.              p[0].funp ? p[0].funp->name : "CATCH",
  4058.              p[1].prog->name, p[1].ob->name,
  4059.              get_line_number(p[1].pc, p[1].prog));
  4060.     debug_message("'%15s' in '%20s' ('%20s')line %d\n",
  4061.              p[0].funp ? p[0].funp->name : "CATCH",
  4062.              p[1].prog->name, p[1].ob->name,
  4063.              get_line_number(p[1].pc, p[1].prog));
  4064.     if (p->funp && strcmp(p->funp->name, "heart_beat") == 0)
  4065.         ret = p->ob?p->ob->name:0; /*crash unliked gc*/
  4066.     }
  4067.     (void)printf("'%15s' in '%20s' ('%20s')line %d\n",
  4068.          p[0].funp ? p[0].funp->name : "CATCH",
  4069.          current_prog->name, current_object->name,
  4070.          get_line_number(pc, current_prog));
  4071.     debug_message("'%15s' in '%20s' ('%20s')line %d\n",
  4072.          p[0].funp ? p[0].funp->name : "CATCH",
  4073.          current_prog->name, current_object->name,
  4074.          get_line_number(pc, current_prog));
  4075.     return ret;
  4076. }
  4077.  
  4078. int get_line_number_if_any() {
  4079.     if (current_prog)
  4080.     return get_line_number(pc, current_prog);
  4081.     return 0;
  4082. }
  4083.  
  4084. static char *find_percent(str)
  4085.     char *str;
  4086. {
  4087.     while(1) {
  4088.     str = strchr(str, '%');
  4089.     if (str == 0)
  4090.         return 0;
  4091.     if (str[1] != '%')
  4092.         return str;
  4093.     str++;
  4094.     }
  4095. }
  4096.  
  4097. static int inter_sscanf(num_arg)
  4098.     int num_arg;
  4099. {
  4100.     char *fmt;        /* Format description */
  4101.     char *in_string;    /* The string to be parsed. */
  4102.     int number_of_matches;
  4103.     char *cp;
  4104.     struct svalue *arg = sp - num_arg + 1;
  4105.  
  4106.     /*
  4107.      * First get the string to be parsed.
  4108.      */
  4109.     if (arg[0].type != T_STRING)
  4110.     bad_arg(1, F_SSCANF);
  4111.     in_string = arg[0].u.string;
  4112.     if (in_string == 0)
  4113.     return 0;
  4114.     /*
  4115.      * Now get the format description.
  4116.      */
  4117.     if (arg[1].type != T_STRING)
  4118.     bad_arg(2, F_SSCANF);
  4119.     fmt = arg[1].u.string;
  4120.     /*
  4121.      * First, skip and match leading text.
  4122.      */
  4123.     for (cp=find_percent(fmt); fmt != cp; fmt++, in_string++) {
  4124.     if (in_string[0] == '\0' || fmt[0] != in_string[0])
  4125.         return 0;
  4126.     }
  4127.     /*
  4128.      * Loop for every % or substring in the format. Update num_arg and the
  4129.      * arg pointer continuosly. Assigning is done manually, for speed.
  4130.      */
  4131.     num_arg -= 2;
  4132.     arg += 2;
  4133.     for (number_of_matches=0; num_arg > 0;
  4134.      number_of_matches++, num_arg--, arg++) {
  4135.     int i, type;
  4136.  
  4137.     if (fmt[0] == '\0') {
  4138.         /*
  4139.          * We have reached end of the format string.
  4140.          * If there are any chars left in the in_string,
  4141.          * then we put them in the last variable (if any).
  4142.          */
  4143.         if (in_string[0]) {
  4144.         free_svalue(arg->u.lvalue);
  4145.         arg->u.lvalue->type = T_STRING;
  4146.         arg->u.lvalue->u.string = string_copy(in_string);
  4147.         arg->u.lvalue->string_type = STRING_MALLOC;
  4148.         number_of_matches++;
  4149.         }
  4150.         break;
  4151.     }
  4152. #ifdef DEBUG
  4153.     if (fmt[0] != '%')
  4154.         fatal("Should be a %% now !\n");
  4155. #endif
  4156.     type = T_STRING;
  4157.     if (fmt[1] == 'd')
  4158.         type = T_NUMBER;
  4159.     else if (fmt[1] != 's')
  4160.         error("Bad type : '%%%c' in sscanf fmt string.", fmt[1]);
  4161.     fmt += 2;
  4162.     /*
  4163.      * Parsing a number is the easy case. Just use strtol() to
  4164.      * find the end of the number.
  4165.      */
  4166.     if (type == T_NUMBER) {
  4167.         char *tmp = in_string;
  4168.         int tmp_num;
  4169.  
  4170.         tmp_num = (int) strtol(in_string, &in_string, 10);
  4171.         if(tmp == in_string) {
  4172.         /* No match */
  4173.         break;
  4174.         }
  4175.         free_svalue(arg->u.lvalue);
  4176.         arg->u.lvalue->type = T_NUMBER;
  4177.         arg->u.lvalue->u.number = tmp_num;
  4178.         while(fmt[0] && fmt[0] == in_string[0])
  4179.         fmt++, in_string++;
  4180.         if (fmt[0] != '%') {
  4181.         number_of_matches++;
  4182.         break;
  4183.         }
  4184.         continue;
  4185.     }
  4186.     /*
  4187.      * Now we have the string case.
  4188.      */
  4189.     cp = find_percent(fmt);
  4190.     if (cp == fmt)
  4191.         error("Illegal to have 2 adjacent %'s in fmt string in sscanf.");
  4192.     if (cp == 0)
  4193.         cp = fmt + strlen(fmt);
  4194.     /*
  4195.      * First case: There was no extra characters to match.
  4196.      * Then this is the last match.
  4197.      */
  4198.     if (cp == fmt) {
  4199.         free_svalue(arg->u.lvalue);
  4200.         arg->u.lvalue->type = T_STRING;
  4201.         arg->u.lvalue->u.string = string_copy(in_string);
  4202.         arg->u.lvalue->string_type = STRING_MALLOC;
  4203.         number_of_matches++;
  4204.         break;
  4205.     }
  4206.     for (i=0; in_string[i]; i++) {
  4207.         if (strncmp(in_string+i, fmt, cp - fmt) == 0) {
  4208.         char *match;
  4209.         /*
  4210.          * Found a match !
  4211.          */
  4212.         match = xalloc(i+1);
  4213.         (void)strncpy(match, in_string, i);
  4214.         in_string += i + cp - fmt;
  4215.         match[i] = '\0';
  4216.         free_svalue(arg->u.lvalue);
  4217.         arg->u.lvalue->type = T_STRING;
  4218.         arg->u.lvalue->u.string = match;
  4219.         arg->u.lvalue->string_type = STRING_MALLOC;
  4220.         fmt = cp;    /* Advance fmt to next % */
  4221.         break;
  4222.         }
  4223.     }
  4224.     if (fmt == cp)    /* If match, then do continue. */
  4225.         continue;
  4226.     /*
  4227.      * No match was found. Then we stop here, and return
  4228.      * the result so far !
  4229.      */
  4230.     break;
  4231.     }
  4232.     return number_of_matches;
  4233. }
  4234.  
  4235. /* test stuff ... -- LA */
  4236. #ifdef OPCPROF
  4237. void opcdump()
  4238. {
  4239.     int i;
  4240.  
  4241.     for(i = 0; i < MAXOPC; i++)
  4242.     if (opcount[i]) printf("%d: %d\n", i, opcount[i]);
  4243. }
  4244. #endif
  4245.  
  4246. /*
  4247.  * Reset the virtual stack machine.
  4248.  */
  4249. void reset_machine(first)
  4250.     int first;
  4251. {
  4252.     csp = control_stack - 1;
  4253.     if (first)
  4254.     sp = start_of_stack - 1;
  4255.     else
  4256.     pop_n_elems(sp - start_of_stack + 1);
  4257. }
  4258.  
  4259. #ifdef TRACE_CODE
  4260.  
  4261. static char *get_arg(a, b)
  4262.     int a, b;
  4263. {
  4264.     static char buff[10];
  4265.     char *from, *to;
  4266.  
  4267.     from = previous_pc[a]; to = previous_pc[b];
  4268.     if (to - from < 2)
  4269.     return "";
  4270.     if (to - from == 2) {
  4271.     sprintf(buff, "%d", from[1]);
  4272.     return buff;
  4273.     }
  4274.     if (to - from == 3) {
  4275.     short arg;
  4276.     ((char *)&arg)[0] = from[1];
  4277.     ((char *)&arg)[1] = from[2];
  4278.     sprintf(buff, "%d", arg);
  4279.     return buff;
  4280.     }
  4281.     if (to - from == 5) {
  4282.     int arg;
  4283.     ((char *)&arg)[0] = from[1];
  4284.     ((char *)&arg)[1] = from[2];
  4285.     ((char *)&arg)[2] = from[3];
  4286.     ((char *)&arg)[3] = from[4];
  4287.     sprintf(buff, "%d", arg);
  4288.     return buff;
  4289.     }
  4290.     return "";
  4291. }
  4292.  
  4293. int last_instructions() {
  4294.     int i;
  4295.     i = last;
  4296.     do {
  4297.     if (previous_instruction[i] != 0)
  4298.         printf("%6x: %3d %8s %-25s (%d)\n", previous_pc[i],
  4299.            previous_instruction[i],
  4300.            get_arg(i, (i+1) %
  4301.                (sizeof previous_instruction / sizeof (int))),
  4302.            get_f_name(previous_instruction[i]),
  4303.            stack_size[i] + 1);
  4304.     i = (i + 1) % (sizeof previous_instruction / sizeof (int));
  4305.     } while (i != last);
  4306.     return last;
  4307. }
  4308.  
  4309. #endif /* TRACE_CODE */
  4310.  
  4311.  
  4312. #ifdef DEBUG
  4313.  
  4314. static void count_inherits(progp, search_prog)
  4315.     struct program *progp, *search_prog;
  4316. {
  4317.     int i;
  4318.  
  4319.     /* Clones will not add to the ref count of inherited progs */
  4320.     if (progp->extra_ref != 1) return; /* marion */
  4321.     for (i=0; i< progp->num_inherited; i++) {
  4322.     progp->inherit[i].prog->extra_ref++;
  4323.     if (progp->inherit[i].prog == search_prog)
  4324.         printf("Found prog, inherited by %s\n", progp->name);
  4325.     count_inherits(progp->inherit[i].prog, search_prog);
  4326.     }
  4327. }
  4328.  
  4329. static void count_ref_in_vector(svp, num)
  4330.     struct svalue *svp;
  4331.     int num;
  4332. {
  4333.     struct svalue *p;
  4334.  
  4335.     for (p = svp; p < svp+num; p++) {
  4336.     switch(p->type) {
  4337.     case T_OBJECT:
  4338.         p->u.ob->extra_ref++;
  4339.         continue;
  4340.     case T_POINTER:
  4341.         count_ref_in_vector(&p->u.vec->item[0], p->u.vec->size);
  4342.         p->u.vec->extra_ref++;
  4343.         continue;
  4344.     }
  4345.     }
  4346. }
  4347.  
  4348. /*
  4349.  * Clear the extra debug ref count for vectors
  4350.  */
  4351. void clear_vector_refs(svp, num)
  4352.     struct svalue *svp;
  4353.     int num;
  4354. {
  4355.     struct svalue *p;
  4356.  
  4357.     for (p = svp; p < svp+num; p++) {
  4358.     switch(p->type) {
  4359.     case T_POINTER:
  4360.         clear_vector_refs(&p->u.vec->item[0], p->u.vec->size);
  4361.         p->u.vec->extra_ref = 0;
  4362.         continue;
  4363.     }
  4364.     }
  4365. }
  4366.  
  4367. /*
  4368.  * Loop through every object and variable in the game and check
  4369.  * all reference counts. This will surely take some time, and should
  4370.  * only be used for debugging.
  4371.  */
  4372. void check_a_lot_ref_counts(search_prog)
  4373.     struct program *search_prog;
  4374. {
  4375.     extern struct object *master_ob;
  4376.     struct object *ob;
  4377.  
  4378.     /*
  4379.      * Pass 1: clear the ref counts.
  4380.      */
  4381.     for (ob=obj_list; ob; ob = ob->next_all) {
  4382.     ob->extra_ref = 0;
  4383.     ob->prog->extra_ref = 0;
  4384.     clear_vector_refs(ob->variables, ob->prog->num_variables);
  4385.     }
  4386.     clear_vector_refs(start_of_stack, sp - start_of_stack + 1);
  4387.  
  4388.     /*
  4389.      * Pass 2: Compute the ref counts.
  4390.      */
  4391.  
  4392.     /*
  4393.      * List of all objects.
  4394.      */
  4395.     for (ob=obj_list; ob; ob = ob->next_all) {
  4396.     ob->extra_ref++;
  4397.     count_ref_in_vector(ob->variables, ob->prog->num_variables);
  4398.     ob->prog->extra_ref++;
  4399.     if (ob->prog == search_prog)
  4400.         printf("Found program for object %s\n", ob->name);
  4401.     /* Clones will not add to the ref count of inherited progs */
  4402.     if (ob->prog->extra_ref == 1)
  4403.         count_inherits(ob->prog, search_prog);
  4404.     }
  4405.  
  4406.     /*
  4407.      * The current stack.
  4408.      */
  4409.     count_ref_in_vector(start_of_stack, sp - start_of_stack + 1);
  4410.     update_ref_counts_for_players();
  4411.     count_ref_from_call_outs();
  4412.     if (master_ob) master_ob->extra_ref++; /* marion */
  4413.  
  4414.     if (search_prog)
  4415.     return;
  4416.  
  4417.     /*
  4418.      * Pass 3: Check the ref counts.
  4419.      */
  4420.     for (ob=obj_list; ob; ob = ob->next_all) {
  4421.     if (ob->ref != ob->extra_ref)
  4422.          fatal("Bad ref count in object %s, %d - %d\n", ob->name,
  4423.           ob->ref, ob->extra_ref);
  4424.     if (ob->prog->ref != ob->prog->extra_ref) {
  4425.         check_a_lot_ref_counts(ob->prog);
  4426.         fatal("Bad ref count in prog %s, %d - %d\n", ob->prog->name,
  4427.           ob->prog->ref, ob->prog->extra_ref);
  4428.     }
  4429.     }
  4430. }
  4431.  
  4432. #endif /* DEBUG */
  4433.  
  4434. /* Generate a debug message to the player */
  4435. static void
  4436. do_trace(msg, fname, post)
  4437. char *msg, *fname, *post;
  4438. {
  4439.     char buf[10000];
  4440.     char *objname;
  4441.  
  4442.     if (!TRACEHB)
  4443.     return;
  4444.     objname = TRACETST(TRACE_OBJNAME) ? (current_object && current_object->name ? current_object->name : "??")  : "";
  4445.     sprintf(buf, "*** %d %*s %s %s %s%s", tracedepth, tracedepth, "", msg, objname, fname, post);
  4446.     add_message(buf);
  4447. }
  4448.  
  4449. struct svalue *apply_master_ob(fun, num_arg)
  4450.     char *fun;
  4451.     int num_arg;
  4452. {
  4453.     extern struct object *master_ob;
  4454.  
  4455.     assert_master_ob_loaded();
  4456.     /*
  4457.      * Maybe apply() should be called instead ?
  4458.      */
  4459.     return sapply(fun, master_ob, num_arg);
  4460. }
  4461.  
  4462. void assert_master_ob_loaded()
  4463. {
  4464.     extern struct object *master_ob;
  4465.     static int inside = 0;
  4466. #ifndef COMPAT_MODE
  4467.     struct svalue *ret;
  4468. #endif
  4469.  
  4470.     if (master_ob == 0 || master_ob->flags & O_DESTRUCTED) {
  4471.     /*
  4472.      * The master object has been destructed. Free our reference,
  4473.      * and load a new one.
  4474.      *
  4475.      * This test is needed because the master object is called from
  4476.      * yyparse() at an error to find the wizard name. However, and error
  4477.      * when loading the master object will cause a recursive call to this
  4478.      * point.
  4479.      *
  4480.      * The best solution would be if the yyparse() did not have to call
  4481.      * the master object to find the name of the wizard.
  4482.      */
  4483.     if (inside) {
  4484.         fprintf(stderr, "Failed to load master object.\n");
  4485.         add_message("Failed to load master file !\n");
  4486.         exit(1);
  4487.     }
  4488.     fprintf(stderr, "assert_master_ob_loaded: Reloading master.c\n");
  4489.     if (master_ob)
  4490.         free_object(master_ob, "assert_master_ob_loaded");
  4491.     /*
  4492.      * Clear the pointer, in case the load failed.
  4493.      */
  4494.     master_ob = 0;
  4495.     inside = 1;
  4496. #ifdef COMPAT_MODE
  4497.         master_ob = load_object("obj/master",0);
  4498. #else
  4499.         master_ob = load_object("secure/master",0);
  4500.  
  4501.         ret = apply_master_ob("get_root_uid", 0);
  4502.         if (ret == 0 || ret->type != T_STRING) {
  4503.         fatal ("get_root_uid() in secure/master.c does not work\n");
  4504.         }
  4505.         master_ob->user = add_name(ret->u.string);
  4506.         master_ob->eff_user = master_ob->user;
  4507. #endif
  4508.     inside = 0;
  4509.     add_ref(master_ob, "assert_master_ob_loaded");
  4510.     fprintf(stderr, "Reloading done.\n");
  4511.     }
  4512. }
  4513.  
  4514. /*
  4515.  * When an object is destructed, all references to it must be removed
  4516.  * from the stack.
  4517.  */
  4518. void remove_object_from_stack(ob)
  4519.     struct object *ob;
  4520. {
  4521.     struct svalue *svp;
  4522.  
  4523.     for (svp = start_of_stack; svp <= sp; svp++) {
  4524.     if (svp->type != T_OBJECT)
  4525.         continue;
  4526.     if (svp->u.ob != ob)
  4527.         continue;
  4528.     free_object(svp->u.ob, "remove_object_from_stack");
  4529.     svp->type = T_NUMBER;
  4530.     svp->u.number = 0;
  4531.     }
  4532. }
  4533.  
  4534. static int
  4535. strpref(p, s)
  4536. char *p, *s;
  4537. {
  4538.     while (*p)
  4539.     if (*p++ != *s++)
  4540.         return 0;
  4541.     return 1;
  4542. }
  4543.